Artoj Posted May 11 Share Posted May 11 (edited) Hi All, I was looking through my myriad of water damaged XB dot matrix listings and found this gem I wrote back in 1986. I am still deciphering a lot of the printout and it looks like I have the whole lot. It is a XB program that needs 32k to add a CALL LINK("PLOT",Y,X,S,C). This as I remember it was created before I made the assembly versions of all the XB CALLs much later. The most important note here that it is in the standard graphics mode and is uses the characters above 33 to create the drawing, you can check when it runs out of characters, the C option tells you the current CHAR in use. I am still reading and typing the XB code, this might take a while (Large Program Whew!), so I will post it here. I am showing you this in case anyone is interested, I will try and hasten my attempt, otherwise be patient. I will post more on the XB Machine code part first, as I do not have the original Assembly listing here anymore, someone might want to disassemble my code. Regards Arto. 1 !*****PLOT ROUTINES***** 2 !****FOR EX/BAS+32K***** 3 !****BY ARTO HEINO****** 4 !*******1986************ 5 ! CALL HIRES 6 ! LOADS MACHINE CODE 7 ! SUB ROUTINE INTO MEMORY 8 ! CALL LINK("PLOT",Y,X,S,C) 9 ! ALL OTHER XB CALLS 10 ! REQUIRES THIS 11 ! ROUTINE 12 !************************ 13 !CALL LINK(PLOT",Y,X,S,C) 14 ! Y=1 TO 192 * 15 ! X=1 TO 255 * 16 ! S=START CHAR * 17 ! C=CURRENT CHAR * 18 !*********************** 19 !CALL LINE(X1,Y1,X2,Y2,S) 20 ! X1=START X CP/ORD * 21 ! Y1=START Y CO/ORD * 22 ! X2=FINAL X CO/ORD * 23 ! Y2=FINAL Y CO/ORD * 24 ! S=START CGAR * 25 !*********************** 26 !CALL CIRCLE(X,Y.R.RA.S) 27 ! X,Y=CENTER CO/ORD * 28 ! R=RADIUS * 29 ! RA=RATIO 1.2=OVAL * 30 ! S=START CHAR * 31 !*********************** 32 !CALL THREEDIM(CHC,S) * 33 ! CHC=FUNCTION CHOICE* 34 ! S=START CHAR * 35 !*********************** 36 ! CALL DRAW(X,Y.A$,S) * 37 ! X=START X CO/ORD * 38 ! Y=START Y CO/ORD * 39 ! A$=DIRECTION FOR * 40 ! PIXEL MOVEMENT * 41 ! L=LEFT * 42 ! R=RIGHT * 43 ! U=UP * 44 ! D=DOWN * 45 ! E,F,G,H=ANGULAR * 46 ! S=START CHAR * 47 !*********************** 48 !CALL JOYDRAW(X,Y,L,XY(),P$(),A,S) 49 ! P$()=RETURN STR$ * 50 ! ARRAY FOR * 51 ! DRAW * 52 ! A=ARRAY NUMBER * 53 ! RETURN * 54 ! S=START CGAR * 55 ! XY()=RETURN X & Y * 56 ! LOCATIONS * 57 ! L=COLOR OF CURS* 58 ! X,Y=START L/CTION* 59 !*********************** 60 !CALL JOYDRW(X,Y,L,S) * 61 ! S=START CHAR * 62 ! X,Y=START CO/ORD * 63 ! L=COLOR OF CURS* 64 !*********************** 65 !CALL DUMP)X1,Y2,Y1,Y2,P,C) 66 ! X1=COLUMN START * 67 ! X2=COLUMN FINISH* 68 ! Y1=ROW START * 69 ! Y2=ROW FINISH * 70 ! P=PRINT MODE * 71 ! 1=NORMAL * 72 ! 2=HALF WIDTH * 73 ! 3=QUART WIDTH* 74 ! 4=EIGHT WIDTH* 75 ! 5=DOUBL WIDTH* 76 ! 6=DOUBL SIZE * 77 ! C=NUM OF COPIES* 78 !*********************** 89 DIM P$(100),XY(2,100) 90 S=34 :: CALL CLEAR 95 FOR X=1 TO 14 :: CALL COLOR(X,5,16):: NEXT X 99 ! CALL DRAW DEMO - SELF PORTAIT 100 CALL DRAW(75,141,"E01R02E02R01E01R01E04U01E01R01E02R01U06E01U01E01U01E01U01E 01U21H01U10E01U09E01U02E01U02E01U01E01U01E06",S) 110 CALL DRAW 120 CALL DRAW 130 CALL DRAW 140 CALL DRAW 150 CALL DRAW 160 CALL DRAW 170 CALL DRAW 180 CALL DRAW . . 350 CALL DRAW 10000 SUB LINE(X1,Y1.X2.Y2,S):: IF X1<X2 THEN X3=1 :: X4=X2-X1 ELSE IF X2<X1 THEN X3=-1 :: X4=X1-X2 10010 IF Y1>Y2 THEN Y3=-1 :: Y4=Y1-Y2 ELSE IF Y2>Y1 THEN Y3=1 :: Y4=Y2-Y1 10020 IF Y4>X4 THEN X5=X4/Y4 :: Y5=1 :: Z1=Y4 ELSE IF X4>Y4 THEN Y5=Y4/X4 :: X5=1 :: Z1=X4 ELSE Z1=Y4 :: X5,X3,Y5,Y3=1 10030 FOR Z=1 TO Z1 :: CALL LINK("PLOT",Y1,X1,S,C):: X1=X1+X5*X3 :: Y1=Y1+Y5*Y3 :: NEXT Z :: SUBEND 11000 SUB DRAW(X,Y,A$,S) 20000 SUB CIRCLE(X1,Y1,R,Q,S) 25000 SUB THREEDIM(@,S) 26010 Z2=150/((X2*X2/1000_+(Y2*Y2/500)+1):: RETURN 26020 Z2=SIN(X2/30)*COS(Y2/18)*Y2*X2/30 :: RETURN 26030 Z2=SQR(X2*X2+Y2*Y2)/4:: RETURN 26040 Z2=SQR(-X2*X2-Y2*Y2+3200):: RETURN 26050 Z2=(SIN(X2/25)*COS(Y2/9)*COS(X2/15)*SIN(Y2/17))*40 :: RETURN 26060 Z2=SIN(X2/4)*X2*Y2/30 :: RETURN 26070 Z2=SIN(X2/20)*X2*Y2/30 :: RETURN 30000 SUB HIRES :: CALL INIT :: CALL LOAD(-31878,0,"",8196,63,248,"",16376,80,76,79,84,32,32,39,20):: MEM=9992 30010 FOR I=1 TO 412 :: READ X :: CALL LOAD(MEM,X):: MEM=MEM+1 :: NEXT I 30020 DATA 0,1,64,65,96,100,128,192,255,191,191,0,194,139,2,0,8,29,4,32,32,40,2,0,8,30 30030 DATA 30040 DATA 30050 DATA 30060 DATA 30070 DATA 30080 DATA 30090 DATA 30100 DATA 30110 DATA 30120 DATA 30130 DATA 30140 DATA 30150 DATA 30160 DATA 30170 DATA 30180 DATA 30185 SUBEND 31000 SUB JOYDRAW(XX,YY,L,XY(,),P$(),A,S) 31500 SUB JOYDRW(XX,YY,L,S) 31800 SUB DUMP(X1,X2,Y1,Y2,SZ,CP) Edited May 11 by Artoj 4 1 Quote Link to comment https://forums.atariage.com/topic/366288-old-graphic-xb-program/ Share on other sites More sharing options...
Artoj Posted May 11 Author Share Posted May 11 Hi All, Here is the CALL LINK("PLOT",Y,X,S,C) routine. 30000 SUB HIRES :: CALL INIT :: CALL LOAD(-31878,0,"",8196,63,248,"",16376,80,76,79,84,32,32,39,20):: MEM=9992 30010 FOR I=1 TO 412 :: READ X :: CALL LOAD(MEM,X):: MEM=MEM+1 :: NEXT I 30020 DATA 0,1,64,65,96,100,128,192,255,191,191,0,194,139,2,0,8,29,4,32,32,40,2,0,8,30 30030 DATA 4,32,32,32,2,0,8,31,4,32,32,32,4,192,2,1,0,3,6,160,40,42,176,160,39 30040 DATA 12,152,2,39,14,26,9,152,2,39,18,19,6,112,160,39,9,216,2,39,18,216,2,38,17 30050 DATA 4,192,2,1,0,1,6,160,40,42,152,2,39,15,26,2,112,160,39,15,208,194,9,51,4 30060 DATA 192,2,1,0,2,6,160,40,42,9,50,4,196,209,3,6,196,10,84,4,192,208,2,6,192 30070 DATA 161,0,4,197,6,195,9,83,209,67,6,197,4,199,6,194,9,82,209,194,6,199,5,135,2 30080 DATA 6,128,0,6,7,19,2,9,22,16,252,192,4,4,32,32,40,4,192,208,1,209,193,6,192 30090 DATA 10,48,2,1,39,0,2,2,0,8,4,32,32,44,249,70,39,0,152,7,39,17,27,16,184 30100 DATA 32,39,9,39,18,152,32,39,8,39,18,19,34,209,224,39,18,4,192,208,160,39,18,2,1 30110 DATA 0,3,6,160,40,100,4,192,208,7,6,192,10,48,2,1,39,0,2,2,0,8,4,32,32 30120 DATA 36,4,192,2,1,0,4,208,135,6,160,40,100,192,4,208,71,4,32,32,32,194,202,4,192 30130 DATA 216,0,131,124,4,91,2,0,30,0,4,32,32,52,4,194,4,32,32,12,152,32,131,74,39 30140 DATA 8,19,6,152,32,131,74,39,10,22,3,208,160,131,75,4,91,152,32,131,74,39,11,22,234 30150 DATA 4,192,208,32,131,75,6,192,176,160,39,13,6,0,22,252,176,160,131,76,4,91,2,3,0 30160 DATA 7,216,192,131,74,6,3,22,252,2,3,0,1,112,160,39,12,216,32,39,10,131,74,152,2 30170 DATA 39,13,26,11,216,32,39,11,131,74,184,32,39,9,131,75,112,160,39,13,2,3,0,2,16 30180 DATA 242,216,194,131,74,4,32,32,8,4,91 30185 SUBEND 3 Quote Link to comment https://forums.atariage.com/topic/366288-old-graphic-xb-program/#findComment-5464588 Share on other sites More sharing options...
Artoj Posted May 12 Author Share Posted May 12 Here are the main Subroutines, I will spend time with the demo and the dump, which are not as important to the program. 10000 SUB LINE(X1,Y1.X2.Y2,S):: IF X1<X2 THEN X3=1 :: X4=X2-X1 ELSE IF X2<X1 THEN X3=-1 :: X4=X1-X2 10010 IF Y1>Y2 THEN Y3=-1 :: Y4=Y1-Y2 ELSE IF Y2>Y1 THEN Y3=1 :: Y4=Y2-Y1 10020 IF Y4>X4 THEN X5=X4/Y4 :: Y5=1 :: Z1=Y4 ELSE IF X4>Y4 THEN Y5=Y4/X4 :: X5=1 :: Z1=X4 ELSE Z1=Y4 :: X5,X3,Y5,Y3=1 10030 FOR Z=1 TO Z1 :: CALL LINK("PLOT",Y1,X1,S,C):: X1=X1+X5*X3 :: Y1=Y1+Y5*Y3 :: NEXT Z :: SUBEND 11000 SUB DRAW(X,Y,A$,S):: FOR M=1 TO LEN(A$)STEP 3 :: DR$=SEG$(A$,M,1):: PX=VAL(SEG$(A$,M+1,2) 11010 V=0 :: ON POS("RLDUEFGH",DR$,1)GOSUB 12000,12100,12200,12300,12400,12500,12600,12700 11020 NEXT M :: GOTO 13000 12000 X1=X+PX :: FOR Z=X TO X1 :: CALL LINK("PLOT",Y,Z,S,C):: NEXT Z :: X=X1 :: RETURN 12100 X1=X-PX :: FOR Z=X TO X1 STEP -1 :: CALL LINK("PLOT",Y,Z,S,C):: NEXT Z :: X=X1 :: RETURN 12200 Y1=Y+PX :: FOR Z=Y TO Y1 :: CALL LINK("PLOT",Y,Z,S,C):: NEXT Z :: Y=Y1 :: RETURN 12300 Y1=Y-PX :: FOR Z=Y TO Y1 STEP -1 :: CALL LINK("PLOT",Z,X,S,C):: NEXT Z :: Y=Y1 :: RETURN 12400 X1=X+PX :: Y1=Y-PX :: FOR Z=X TO X1 :: CALL LINK("PLOT",Y+V,Z,S,C):: V=V-1 :: NEXT Z :: Y=Y1 :: X=X1 :: RETURN 12500 X1=X+PX :: Y1=Y+PX :: FOR Z=X TO X1 :: CALL LINK("PLOT",Y+V,Z,S,C):: V=V+1 :: NEXT Z :: Y=Y1 :: X=X1 :: RETURN 12600 X1=X-PX :: Y1=Y+PX :: FOR Z=Y TO Y1 :: CALL LINK("PLOT",Y+V,Z,S,C):: V=V-1 :: NEXT Z :: Y=Y1 :: X=X1 :: RETURN 12700 X1=X-PX :: Y1=Y-PX :: FOR Z=Y TO Y1 STEP -1 :: CALL LINK("PLOT",Y+V,Z,S,C):: V=V-1 :: NEXT Z :: Y=Y1 :: X=X1 :: RETURN 13000 SUBEND 20000 SUB CIRCLE(X1,Y1,R,Q,S):: L=INT(Q):: G=(Q-L)*10 :: IF L>G THEN L1-1 :: G1=1/L ELSE IF G>L THEN G1=1 :: L1=1/G ELSE G1,L1=1 20010 FOR N=1 TO 4*R :: Y=Y1+(R*SIN(N/(R*2)*PI))*L1 :: X=X1+(R*COS(N/(R*2)*PI))*G1 :: CALL LINK("PLOT",Y,X,S,C):: NEXT N :: SUBEND 25000 SUB THREEDIM(@,S):: N.M=8 :: X0,Y0=-40 :: X1,Y1=40 :: N0=(X1-X0)/N :: M0=(Y1-Y0)/M 25010 A-112 :: B=112 :: A1=0.52359878 :: S12=SIN(A1) :: C1=COS(A1) 25020 FOR Y2=Y0 TO Y1 STEP M0 :: FOR X2=X0 TO X1 :: ON @ GOSUB 26010,26020,26030,26040,26050,26060,26070 25025 GOSUB 27000 :: CALL LINK("PLOT",B-V/2,A+U,S,C):: NEXT X2 :: NEXT Y2 25030 FOR X2=X0 TO X1 STEP N0 :: FOR Y2-Y0 TO Y1 :: ON @ GOSUB 26010,26020,26030,26040,26050,26060,26070 25035 GOSUB 27000 :: CALL LINK("PLOT",B-V/2,A+U,S,C):: NEXT Y2 :: NEXT X2 25040 GOTO 28000 26010 Z2=150/((X2*X2/1000_+(Y2*Y2/500)+1):: RETURN 26020 Z2=SIN(X2/30)*COS(Y2/18)*Y2*X2/30 :: RETURN 26030 Z2=SQR(X2*X2+Y2*Y2)/4:: RETURN 26040 Z2=SQR(-X2*X2-Y2*Y2+3200):: RETURN 26050 Z2=(SIN(X2/25)*COS(Y2/9)*COS(X2/15)*SIN(Y2/17))*40 :: RETURN 26060 Z2=SIN(X2/4)*X2*Y2/30 :: RETURN 26070 Z2=SIN(X2/20)*X2*Y2/30 :: RETURN 27000 U1=X2-Y2*C1 :: V1=Z2+Y2*S1 :: U=INT(U1):: V=INT(V1):: RETURN 28000 SUBEND 30000 SUB HIRES :: CALL INIT :: CALL LOAD(-31878,0,"",8196,63,248,"",16376,80,76,79,84,32,32,39,20):: MEM=9992 30010 FOR I=1 TO 412 :: READ X :: CALL LOAD(MEM,X):: MEM=MEM+1 :: NEXT I 30020 DATA 0,1,64,65,96,100,128,192,255,191,191,0,194,139,2,0,8,29,4,32,32,40,2,0,8,30 30030 DATA 4,32,32,32,2,0,8,31,4,32,32,32,4,192,2,1,0,3,6,160,40,42,176,160,39 30040 DATA 12,152,2,39,14,26,9,152,2,39,18,19,6,112,160,39,9,216,2,39,18,216,2,38,17 30050 DATA 4,192,2,1,0,1,6,160,40,42,152,2,39,15,26,2,112,160,39,15,208,194,9,51,4 30060 DATA 192,2,1,0,2,6,160,40,42,9,50,4,196,209,3,6,196,10,84,4,192,208,2,6,192 30070 DATA 161,0,4,197,6,195,9,83,209,67,6,197,4,199,6,194,9,82,209,194,6,199,5,135,2 30080 DATA 6,128,0,6,7,19,2,9,22,16,252,192,4,4,32,32,40,4,192,208,1,209,193,6,192 30090 DATA 10,48,2,1,39,0,2,2,0,8,4,32,32,44,249,70,39,0,152,7,39,17,27,16,184 30100 DATA 32,39,9,39,18,152,32,39,8,39,18,19,34,209,224,39,18,4,192,208,160,39,18,2,1 30110 DATA 0,3,6,160,40,100,4,192,208,7,6,192,10,48,2,1,39,0,2,2,0,8,4,32,32 30120 DATA 36,4,192,2,1,0,4,208,135,6,160,40,100,192,4,208,71,4,32,32,32,194,202,4,192 30130 DATA 216,0,131,124,4,91,2,0,30,0,4,32,32,52,4,194,4,32,32,12,152,32,131,74,39 30140 DATA 8,19,6,152,32,131,74,39,10,22,3,208,160,131,75,4,91,152,32,131,74,39,11,22,234 30150 DATA 4,192,208,32,131,75,6,192,176,160,39,13,6,0,22,252,176,160,131,76,4,91,2,3,0 30160 DATA 7,216,192,131,74,6,3,22,252,2,3,0,1,112,160,39,12,216,32,39,10,131,74,152,2 30170 DATA 39,13,26,11,216,32,39,11,131,74,184,32,39,9,131,75,112,160,39,13,2,3,0,2,16 30180 DATA 242,216,194,131,74,4,32,32,8,4,91 30185 SUBEND 31000 SUB JOYDRAW(XX,YY,L,XY(,),P$(),A,S):: P2$="R" :: T1=1 :: CALL CHAR(33,"40A040):: CALL SPRITE(#1,33,L,YY,XX) 31010 CALL KEY(1,K,T):: CALL JOYST(1,X,Y):: Y=-Y :: IF X OR Y OR T THEN 31015 ELSE 31010 31015 IF K=19 THEN 31200 31020 XX=XX+X/4 :: YY=YY+Y/4 :: CALL LOCATE(#1,YY,XX) 31021 IF K=18 AND T=1 THEN A=A+1 :: XY(1,A)=XX :: XY(2,A)=YY :: T1=0 ELSE IF K<>18 THEN T1=1 :: GOTO 31010 31090 AM=-(X=4)-(X=-4)*2-(Y=4)*4-(Y=-4)*8 :: IF AM=0 THEN 31160 ELSE H=D :: D=D-(M=AM)+(M<>AM)*(D-1) 31100 M=AM :: P1$=SEG$("RL DUE FGH",AM,1):: IF P2$<>P1$ THEN Z$-STR$(H):: P$(A)=P$(A)&P2$&RPT$("0",2-LEN(Z$))&Z$ 31150 P2$=P1$ 31160 CALL LINK("PLOT",YY,XX,S,C):: GOTO 31010 31200 CALL DELSPRITE(#1):: SUBEND 31500 SUB JOYDRW(XX,YY,L,S):: CALL CHAR(33,"40A040):: CALL SPRITE(#1,33,L,YY,XX) 31510 CALL KEY(1,K,T):: CALL JOYST(1,X,Y):: Y=-Y :: IF X OR Y OR T THEN 31515 ELSE 31510 31515 IF K=19 THEN 31700 31520 XX=XX+X/4 :: YY=YY+Y/4 :: CALL LOCATE(#1,YY,XX):: IF K<>18 THEN 31510 31660 CALL LINK("PLOT",YY,XX,S,C):: GOTO 31510 31700 SUBEND The CALL JOYDRAW was made to record the CALL DRAW string parameters, so it can be turned into data code for use in a program. This is how I traced my features (DEMO) into the strings. Regards Arto. 3 Quote Link to comment https://forums.atariage.com/topic/366288-old-graphic-xb-program/#findComment-5464932 Share on other sites More sharing options...
Artoj Posted May 13 Author Share Posted May 13 Hi All, I have decided not to include the CALL DUMP routine, it was made for only for the EPSON type dot matrix printer, with a bucket load of control characters. I have spotted an error in one of the previous lines: 31100 M=AM :: P1$=SEG$("RL DUE FGH",AM,1):: IF P2$<>P1$ THEN Z$=STR$(H):: P$(A)=P$(A)&P2$&RPT$("0",2-LEN(Z$))&Z$ Here is the Demo part of the program: 99 ! CALL DRAW DEMO - SELF PORTAIT 100 CALL DRAW(75,141,"E01R02E02R01E01R01E04U01E01R01E02R01U06E01U01E01U01E01U01E01U21H01U10E01U09E01U02E01U02E01U01E01U01E06",S) 110 CALL DRAW(107,58,"E05R01E01R01E01R09F01R06F01R02F02R01F05D01F01D01F01D01F03D02F02D01F01D01F01D14",S) 120 CALL DRAW(102,64,"G01D03G01D25F01D01F01D06F01D03F02D01F04R01F04R02F01R08E01R03E01R01E06R01E03U03E01U04",S) 130 CALL DRAW(101,86,"U01E01U06E01U01E02",S):: CALL DRAW(107,76,"R06L02D01L05",S) 140 CALL DRAW(111,55,"R07F02R01F01D01R04D01F01D01F02D01F02D01F03R02F01R01F01R02F02D01F01D09G01D02F01D03G01D03U03E01U03E01R01D08G01L02D01",S) 150 CALL DRAW(128,75,"R06L04D01L01D01G01L01G02R01F01E02F01D01G01E01F01R01E01U02L04R05F02L01F01G01",S) 160 CALL DRAW(114,86,"E02H01L01G01H01E01G01L02H01G01L02E02R01E01R02F01R02F01H01E01H01L01",S) 170 CALL DRAW(117,82,"D03",S):: CALL DRAW(126,83,"F01R01F01",S):: CALL DRAW(139,75,"F01D03R01D01U02",S) 180 CALL DRAW(141,92,"D03G01D07",S):: CALL DRAW(137,98,"G01D04G01D01G01D01G01D01G01D02G01",S) 190 CALL DRAW(118,111,"D02",S):: CALL DRAW(120,111,"F01E01",S):: CALL DRAW(107,113,"D03F01D10F01D08F03H03U04L01H01U02H01U02G01D01G02D01G01",S) 200 CALL DRAW(102,131,"D04R01F01H02L01H01U03E02U03H02U09H01U01L01U02H01F01E01G01D05G01D01G01",S) 210 CALL DRAW(92,129,"F01U01E03R01E02",S):: CALL DRAW(117,122,"F01D03F01D01",S):: CALL DRAW(132,118,"D05G01",S) 220 CALL DRAW(105,101,"D03F01D01F01D02F01D01F02",S):: CALL DRAW(122,56,"F01R01F01",S) 230 CALL DRAW(141,109,"D01F01D03F01D07F01D03",S):: CALL DRAW(128,56,"F01D03F01D02F01D01R01D01R01D02F02",S) 240 CALL DRAW(117,88,"D02G02D02R01E01R01F01H01L01G01F03G02L01G01L02G04D01U01L01U01R01U01E02U01R02E02R02",S) 250 CALL DRAW(123,88,"F02D01U01R01F01D01G02L01H01G01",S):: CALL DRAW(134,66,"F06",S) 260 CALL DRAW(123.96,"R04F01R01D01R02F01R01D03G02E01U02H01L01H01L01L02H01L01",S) 270 CALL DRAW(119,100,"R07F-1R02F01G01L03G01L11H01L01E01R01E01R03D01R04",S) 280 CALL DRAW(118,106,"R05E01R01E01R01",S) 290 CALL DRAW(149,77,"D05F01D04F01D01F03D01F01D07G01D06F01D01F01D01F04R02F01R02F01R01F01R02F01R04",S) 300 CALL DRAW(165,127,"H01U01H01U01H01U01H01U02H01G01H03L01H01L01U01L01U07H01U07H01U01",S) 310 CALL DRAW(152,114,"D04G01D01G01D02G01D01G01D01G01D04G01D04F01D01F01H01U01H01U02H01U07E01U09H01U01H02",S) 320 CALL DRAW(110,134,"R02F01R01F01D04R01D01F01D01F01D02F01D04F01D04F02D04",S) 330 CALL DRAW(144,131,"G04D01F03D08G01D02G01D02G01D03F01D02G01D02",S) 340 CALL DRAW(150,157,"E07D14U09L04R09L02U05D12U03R02L02U02R01",S) 350 CALL DRAW(164,155,"D04",S):: CALL DRAW(166,159,"U04F03D01U04",S):: CALL DRAW(172,155,"R01F01D02G01L01H01U02",S) 510 !CALL DUMP(8,24,7,21,6,1) 9999 GOTO 9999 Regards Arto. 2 Quote Link to comment https://forums.atariage.com/topic/366288-old-graphic-xb-program/#findComment-5465559 Share on other sites More sharing options...
+OLD CS1 Posted May 13 Share Posted May 13 15 minutes ago, Artoj said: I have decided not to include the CALL DUMP routine, it was made for only for the EPSON type dot matrix printer, with a bucket load of control characters. Most printers from the era are in some way Epson-compatible. Did you design for specific Epson printers or functionality? Quote Link to comment https://forums.atariage.com/topic/366288-old-graphic-xb-program/#findComment-5465564 Share on other sites More sharing options...
Artoj Posted May 13 Author Share Posted May 13 3 minutes ago, OLD CS1 said: Most printers from the era are in some way Epson-compatible. Did you design for specific Epson printers or functionality? Yes, a Brother M1109/M1009 I think, I have it stored somewhere, the EPROM died a slow death. I used it mainly for my program listings so I could change and add improvements by hand. All my software disks has vanished into the Ether a long time ago. I hope to get a lot of my printed programs back to life over time. I wrote some stuff for the MicroBee as well. Regards Arto. Quote Link to comment https://forums.atariage.com/topic/366288-old-graphic-xb-program/#findComment-5465566 Share on other sites More sharing options...
+arcadeshopper Posted May 13 Share Posted May 13 i'll not TIPI has a nice color epson emulation in its PI.PIO printing system thanks for sharing the program 1 Quote Link to comment https://forums.atariage.com/topic/366288-old-graphic-xb-program/#findComment-5465604 Share on other sites More sharing options...
Artoj Posted May 14 Author Share Posted May 14 10 hours ago, arcadeshopper said: TIPI has a nice color epson emulation If there is emulation, then I might include it, give me some time, I am deciphering each line in zoom mode LOL. I also found a MiniMem version as well, it looks like I rewrote it with more parameters, it needs to be disassembled at some point. Regards Arto. 2 Quote Link to comment https://forums.atariage.com/topic/366288-old-graphic-xb-program/#findComment-5466015 Share on other sites More sharing options...
Artoj Posted May 14 Author Share Posted May 14 Hi All, Here is the complete program as a TEXT file, I will start on the MiniMem version shortly. Regards Arto. TIDraw1a 2 1 Quote Link to comment https://forums.atariage.com/topic/366288-old-graphic-xb-program/#findComment-5466179 Share on other sites More sharing options...
Artoj Posted May 14 Author Share Posted May 14 Hi All, Here is a different HIRES program, it is not the same as the XB version, as I no longer have any other data than the listing, I cannot comment on all it's functions as yet. The paper was torn on one number but I figured it was a 2 by the left over parts, Line 10030, the "2" was at second from the end. I hope it works OK, if some one dissembles it, that should clear up it any issues. Regards Arto. 100 REM ***************** 110 REM * HIRES ROUTINE * 120 REM * MINIMEM +32K * 130 REM ***************** 140 REM * BY ARTO HEINO * 150 REM * 10/3/86 * 160 REM ***************** 161 REM *VARIABLES USED * 162 REM * X=1 TO 255 * 163 REM * Y=1 TO 191 * 164 REM *SET=1(ON)0(OFF)* 165 REM * START=MEMLOC * 166 REM * FINIS=MEMLOC * 167 REM * A,B,Q=SUBRTN * 168 REM ***************** 169 REM *DO NOT INCLUDE * 170 REM *ANY REMS OR ANY* 171 REM *STRINGS IN YOUR* 172 REM *PROGRAM********* 173 CALL CLEAR 180 REM *INITIALIZE LINK* 190 GOSUB 10000 200 REM *SCREEN MEM LOCT* 210 START=9216 220 FINIS=15360 230 REM *CLR SCREEN MEM.* 240 GOSUB 11000 250 REM *POINT X,Y,SET * 260 X=128 270 Y=100 280 SET=1 290 GOSUB 12000 300 REM * LINK ROUTINE * 310 CALL LINK(HIRES") 320 REM * PRESS FUNC 9 * 330 REM *RETURN TO BASIC* 340 REM *RESTORE CURSOR * 350 CALL POKEV(1008,255,129,129,129,129,129,129,255) 360 END 9999 GOTO 9999 10000 CALL LOAD(28702,127,224,"",32736,72,73,82,69,83,32,125,0) 10010 CALL LOAD(32000,2,224,112,184,2,0,0,2,4,32,96,52,2,0,2,6,4,32,96,52,2,0,3,255) 10020 CALL LOAD(32024,4,32,96,52,2,0,4,3,4,32,96,52,2,0,5,54,4,32,96,52,2,0,7,15) 10030 CALL LOAD(32048,4,32,96,52,2,0,24,0,4,194,4,193,4,32,96,36,5,128,2,33,1,0,2,129) 10040 CALL LOAD(32072,0,0,22,248,5,130,2,130,0,3,22,243,4,192,4,193,4,32,96,36,5,128,2,128) 10050 CALL LOAD(32096,24,0,22,250,2,0,32,0,2,1,79,79,4,32,96,36,5,128,2,128,56,0,22,250) 10060 CALL LOAD(32120,2,0,27,0,2,1,208,0,4,32,96,36,2,0,0,0,2,1,36,0,2,2,24,0) 10070 CALL LOAD(32144,4,32,96,40,4,224,131,116,4,32,96,32,192,96,131,117,2,129,0,15,22,249,2,0) 10080 CALL LOAD(32168,0,0,4,32,96,52,4,224,131,124,4,91) 10090 RETURN 11000 FOR CLR=STRART TO FINIS STEP 32 11010 CALL LOAD(CLR,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0) 11020 NEXT CLR 11030 RETURN 12000 A=INT(X/8)*8+INT(Y/8)*256+(Y-INT(Y/8)*8) 12010 B=X-INT(X)/8)*8 12020 B=-(B=0)*128-(B=1)*64-(B=2)*32-(B=3)*16-(B=4)*8-B=5)*4-(B=6)*2-(B=7) 12030 CALL PEEK(A+START,Q) 12040 B=B-((Q+B<256)*(SET=1))*Q+((Q-B>-1)*(SET=0))*Q-((Q+B>255)*(SET=1))*(255-B) 12050 CALL LOAD(A+STSRT,B) 12060 RETURN TIDrawMM1a 3 Quote Link to comment https://forums.atariage.com/topic/366288-old-graphic-xb-program/#findComment-5466212 Share on other sites More sharing options...
Artoj Posted June 18 Author Share Posted June 18 On 5/14/2024 at 10:00 PM, Artoj said: Here is the complete program as a TEXT file I have run the program(TIDraw1a) on Classic99 and found a few mistakes, they are all fixed, except, as the Machine code works fine but runs out of characters, which I had fixed in the final version, which is lost to time. Sooo, I had to create, adapt and figure out a XB Dissembler program to run after I loaded the HIRES subroutine into memory. It works fine and has given me a basic disassembly, which I can label and annotate, I will upload it as soon as the code makes complete sense LOL. I will do the same for all other Loaded Machine Code I find, Regards Arto. 2 Quote Link to comment https://forums.atariage.com/topic/366288-old-graphic-xb-program/#findComment-5488134 Share on other sites More sharing options...
Artoj Posted June 19 Author Share Posted June 19 (edited) Hi All, The demo pic is now working fine, I have yet to test all of the subroutines as I have been busy rewriting the Assembly code, enjoy. Regards Arto. XBDRAW1 Edited June 19 by Artoj 2 Quote Link to comment https://forums.atariage.com/topic/366288-old-graphic-xb-program/#findComment-5488767 Share on other sites More sharing options...
Artoj Posted June 20 Author Share Posted June 20 (edited) Hi All, I have tested and fixed many little syntax errors, the only subroutines untested is the JOYstick routines, as I do not have a Joystick, also the Screen dump routine as well. Here is a collage of the tests, regards Arto. (i will upload the latest version shortly) Edited June 20 by Artoj 5 Quote Link to comment https://forums.atariage.com/topic/366288-old-graphic-xb-program/#findComment-5489040 Share on other sites More sharing options...
+OLD CS1 Posted June 20 Share Posted June 20 43 minutes ago, Artoj said: Hi All, I have tested and fixed many little syntax errors, the only subroutines untested is the JOYstick routines, as I do not have a Joystick, also the Screen dump routine as well. Here is a collage of the tests, regards Arto. (i will upload the latest version shortly) What is the mathematical formula for that middle pic? 3 Quote Link to comment https://forums.atariage.com/topic/366288-old-graphic-xb-program/#findComment-5489052 Share on other sites More sharing options...
Artoj Posted June 20 Author Share Posted June 20 3 minutes ago, OLD CS1 said: What is the mathematical formula for that middle pic? LOL, besides the CALL DRAW routine, I would say DNA from Finland. 4 Quote Link to comment https://forums.atariage.com/topic/366288-old-graphic-xb-program/#findComment-5489053 Share on other sites More sharing options...
Artoj Posted June 20 Author Share Posted June 20 Hi All, Here is the Program and TXT listing, regards Arto XBDRAW2 TIDraw2a.txt 4 Quote Link to comment https://forums.atariage.com/topic/366288-old-graphic-xb-program/#findComment-5489058 Share on other sites More sharing options...
Artoj Posted July 3 Author Share Posted July 3 (edited) Hi All, I had to write a quick and dirty disassembly program in XB just so I could work out what I wrote 30 years ago, I did most of it by hand, but it seems to have bore fruit, as all of it makes sense. What I did , is to add the XB call load subroutines at the end on the dissembler, which ran first, then the output file was saved to disk, which I then cleaned up in Notepad. I used Classic99, what a great piece of software!!! Regards Arto XBDRAW1 CALL LINK("PLOT",Y,X,S,C) S= START CHAR C= CURRENT CHAR _______________ |_|_|_|_I_|_|_|_| BYTE 0 |_|_|_|_I_|_|_|_| |_|_|_|_I_|_|_|_| |_|_|_|_I_|_|_|_| |_|_|_|_I_|_|_|_| |_|_|_|_I_|_|_|_| |_|_|_|_I_|_|_|_| |_|_|_|_I_|_|_|_| BYTE 7 NUMASG EQU >2008 NUMREF EQU >200C VSBW EQU >2020 VMBW EQU >2024 VSBR EQU >2028 VNBR EQU >202C ERR EQU >2034 GPLWS EQU >83E0 FAC EQU >834A STATUS EQU >837C GPL STATUS 9984 2700 BSS 8 VDP RAM BUFFER FOR CHAR PATTERN 9992 2708:00 BYTE >00 9993 2709:01 BYTE >01 9994 270A:40 BYTE >40 9995 270B:41 BYTE >41 9996 270C:60 BYTE >60 OFFSET 9997 270D:64 BYTE >64 9998 270E:80 BYTE >80 9999 270F:C0 BYTE >C0 10000 2710:FF BYTE >FF 10001 2711:BF BYTE >BF START CHAR 10002 2712:BF BYTE >BF CURRENT CHAR 10003 2713:00 BYTE >00 ******************************* START 10004 2714:C28B MOV R11,R10 SAVE RETURN 10006 2716:0200 LI R0,>081D VDP RAM ADDRESS PATTERN TABLE 10008 2718:081D 10010 271A:0420 BLWP @VSBW 10014 271E:0200 LI R0,>081E 10016 2720:081E 10018 2722:0420 BLWP @VSBW 10022 2726:0200 LI R0,>081F 10024 2728:081F 10026 272A:0420 BLWP @VSBW *************************** 10030 272E:04C0 CLR R0 R0 INDICATES NUMBERIC VALUE 10032 2730:0201 LI R1,>0003 3RD ARGUEMENT = START CHARACTER ******* 10034 2732:0003 10036 2734:06A0 BL BR1 GET ARGUEMENT INTO R2 10040 2738:B0A0 AB @270C,R2 ADD >60 (96) TO R2 (CURRENT CHAR) 10044 273C:9802 CB R2,@270E COMPARE R2 TO >80 (128) 10048 2740:1A09 JL JM1 GOTO JM1 IF IT IS LESS 10050 2742:9802 CB R2,@2712 COMPARE R2 TO FIRST RUN >BF (191)THEN USE UPDATED 2712 10054 2746:1306 JEQ JM1 GOTO JM1 IF IT IS EQUAL 10056 2748:70A0 SB @2709,R2 SUBTRACT >01 FROM R2 10060 274C:D802 MOVB R2,@2712 MOVE R2 TO >2712 AND >2711, UPDATED 10064 2750:D802 MOVB R2,@2711 START CHARACTER *************************** JM1 10068 2754:04C0 CLR R0 R0 INDICATES NUMERIC VALUE 10070 2756:0201 LI R1,>0001 1ST ARGUEMENT Y SCREEN LOCATION ****** 10072 2758:0001 10074 275A:06A0 BL BR1 GET ARGUEMENT INTO R2 10078 275E:9802 CB R2,@270F COMPARE R2 TO >C0 (192) 10082 2762:1A02 JL JM2 GOTO JM2 IF IT IS LESS 10084 2764:70A0 SB @270F,R2 SUBTRACT >C0 (192) FROM R2 JM2 10088 2768:D0C2 MOVB R2,R3 MOV R2 TO R3 10090 276A:0933 SRL R3,3 SHIFT R3 BY 3 BITS = DIVIDE BY 8 (R3 = Y VDP POSTION) ************************** 10092 276C:04C0 CLR R0 R0 INDICATES NUMERIC VALUE 10094 276E:0201 LI R1,>0002 2ND ARGUEMENT X SCREEN LOCATION ****** 10096 2770:0002 10098 2772:06A0 BL BR1 GET ARGUEMENT INTO R2 10102 2776:0932 SRL R2,3 SHIFT R2 BY 3 BITS = DIVIDE BY 8 ************************************ * PROCESS INPUT DATA TO SUITABLE FORM FOR VDP * R3 = Y --> R4 R5 * R2 = X --> R7 ************************************ 10104 2778:04C4 CLR R4 PROCESSING Y 10106 277A:D103 MOVB R3,R4 10108 277C:06C4 SWPB R4 10110 277E:0A54 SLA R4,5 SHIFT R4 BY 5 BITS = MPLY BY 32 10112 2780:04C0 CLR R0 10114 2782:D002 MOVB R2,R0 PROCESSING X 10116 2784:06C0 SWPB R0 10118 2786:A100 A R0,R4 VALUE FILLS RH BYTE IN R4 10120 2788:04C5 CLR R5 10122 278A:06C3 SWPB R3 10124 278C:0953 SRL R3,5 SHIFT R3 BY 5 BITS = DIVIDE BY 32 10126 278E:D143 MOVB R3,R5 10128 2790:06C5 SWPB R5 10130 2792:04C7 CLR R7 10132 2794:06C2 SWPB R2 10134 2796:0952 SRL R2,5 SHIFT R2 BY 5 BITS = DIVIDE BY 32 10136 2798:D1C2 MOVB R2,R7 10138 279A:06C7 SWPB R7 10140 279C:0587 INC R7 10142 279E:0206 LI R6,>8000 R6 START OF INDEX 10144 27A0:8000 JM4 10146 27A2:0607 DEC R7 10148 27A4:1302 JEQ JM3 GOTO JM3 IF R7 = 0 10150 27A6:0916 SRL R6,1 SHIFT R6 BY 1 BIT = DIVIDE BY 2 10152 27A8:10FC JMP JM4 GOTO JM4 ************************************ * NOW PUT VALUES INTO CPU AFTER READING VDP - THIS SECTION PROCESSES THEM ************************************ JM3 10154 27AA:C004 MOV R4,R0 R0 = ADDRESS IN VDP RAM 10156 27AC:0420 BLWP @VSBR READ VDP RAM 10160 27B0:04C0 CLR R0 10162 27B2:D001 MOVB R1,R0 MOVE VDP DATA INTO R0 AND R7 10164 27B4:D1C1 MOVB R1,R7 10166 27B6:06C0 SWPB R0 PUT DATA INTO LSB 10168 27B8:0A30 SLA R0,3 SHIFT R0 BY 3 BITS = MPLY BY 8 ( STARTING ADR IN VDP RAM) 10170 27BA:0201 LI R1,>2700 STARTING ADRESS IN CPU RAM 10172 27BC:2700 10174 27BE:0202 LI R2,>0008 R2 = MOVE 8 BYTES INTO CPU RAM 10176 27C0:0008 10178 27C2:0420 BLWP @VMBR PUT 8 BYTES FROM VDP RAM R0 TO CPU >2700 10182 27C6:F946 SOC R6,@2700(R6) SET ZERO CORESPONDING TO >2700 INDEXED BY R6 10186 27CA:9807 CB R7,@2711 COMPARE R7 TO >2711 WHICH IS THE START CHARACTER 10190 27CE:1B10 JH JM5 10192 27D0:B820 AB @2709,@2712 UPDATE CURRENT CHR 10198 27D6:9820 CB @2708,@2712 10204 27DC:1322 JEQ JM6 10206 27DE:D1E0 MOVB @2712,R7 R7 = UPDATED CHR 10210 27E2:04C0 CLR R0 10212 27E4:D0A0 MOVB @2712,R2 R2 = UPDATED CURRENT CHR ************************************ 10216 27E8:0201 LI R1,>0003 3RD ARGUEMENT 10218 27EA:0003 10220 27EC:06A0 BL BR2 RETURN ARGUEMENT ************************************ * NOW WRITE THE CPU VALUES INTO VDP - THIS SECTION UPDATES THE VDP ************************************ JM5 10224 27F0:04C0 CLR R0 10226 27F2:D007 MOV R7,R0 R7 HAD THE UPDATED CHR 10228 27F4:06C0 SWPB R0 CURRENT CHR AT R0 MSB 10230 27F6:0A30 SLA R0,3 SHIFT R0 BY 3 BITS = MPLY BY 8 (STARTING ADDRESS IN VDP) 10232 27F8:0201 LI R1,>2700 STARTING ADDRESS IN CPU RAM FOR CHR PATTERN 10234 27FA:2700 10236 27FC:0202 LI R2,>0008 R2 = MOVE 8 BYTES INTO VDP RAM 10238 27FE:0008 10240 2800:0420 BLWP @VMBW PUT 8 BYTES INTO VDP RAM R0 FROM CPU >2700 ************************************ * RETURN CURRENT CHAR TO LINK ARGUEMENT AND EXIT BACK TO XB ************************************ 10244 2804:04C0 CLR R0 10246 2806:0201 LI R1,>0004 4TH ARGUEMENT 10248 2808:0004 10250 280A:D087 MOVB R7,R2 10252 280C:06A0 BL BR2 RETURN 4TH ARGUEMENT 10256 2810:C004 MOV R4,R0 ADDRESS IN VDP 10258 2812:D047 MOVB R7,R1 BYTE TO WRITE 10260 2814:0420 BLWP @VSBW PLOT BIT 10264 2818:C2CA MOV R10,R11 READY TO LEAVE 10266 281A:04C0 CLR R0 10268 281C:D800 MOVB R0,@STATUS 10272 2820:045B B *R11 RETURN TO CALLING LINK PROGRAM IN XB *********************************** JM6 10274 2822:0200 LI R0,>1E00 ERROR "BAD VALUE" 10276 2824:1E00 10278 2826:0420 BLWP @ERR ***************************** * R0= TYPE, 0 = NUMERIC * GET ARGUEMENT R1= ARGUEMENT NUMBER * R2= CURRENT CHAR ***************************** BR1 10282 282A:04C2 CLR R2 CLEARS R2 (CURRENT CHAR) 10284 282C:0420 BLWP @NUMREF 10288 2830:9820 CB @FAC,@2708 STACK BYTE 0 COMPARE TO >00 10294 2836:1306 JEQ JM7 GOTO JM7 IF EQUAL 10296 2838:9820 CB @FAC,@270A STACK BYTE 0 COMPARE TO >40 (64) 10302 283E:1603 JNE JM8 GOTO JM8 IF NOT EQUAL 10304 2840:D0A0 MOVB @FAC+1,R2 STACK BYTE 1 MOVE BYTE TO R2 (CURRENT CHAR) JM7 10308 2844:045B B *R11 RETURN JM8 10310 2846:9820 CB @FAC,@270B STACK BYTE 0 10316 284C:16EA JNE JM6 10318 284E:04C0 CLR R0 10320 2850:D020 MOVB @FAC+1,R0 STACK BYTE 1 10324 2854:06C0 SWPB R0 JM9 10326 2856:B0A0 AB @270D,R2 ADD >64 (100) TO R2 (CURRENT CHAR) 10330 285A:0600 DEC R0 10332 285C:16FC JNE JM9 GOTO JM9 IF R0<>0 10334 285E:B0A0 AB @FAC+2,R2 STACK BYTE +2 INTO R2 (CURRENT CHAR) 10338 2862:045B B *R11 RETURN **************************** * R0 * RETURN ARGUEMENT R1 * R2 **************************** BR2 10340 2864:0203 LI R3,>0007 SET INDEX LOOP 8 TIMES (Y NEW CHR POSITION) 10342 2866:0007 JM10 10344 2868:D8C0 MOVB R0,@FAC(R0) STACK BYTE 0 INDEX R0 10348 286C:0603 DEC R3 10350 286E:16FC JNE JM10 GOTO JM10 IF R3<>0 10352 2870:0203 LI R3,>0001 SET Y CHR TO 1 10354 2872:0001 10356 2874:70A0 SB @270C,R2 SUBTRACT @270C FROM R2 (CURRENT CHAR) 10360 2878:D820 MOVB @270A,@FAC STACK BYTE 0 JM12 10366 287E:9802 CB R2,@270D 10370 2882:1A0B JL JM11 GOTO JM11 IF R2 < @270D 10372 2884:D820 MOVB @270B,@FAC STACK BYTE 0 10378 288A:B820 AB @2709,@FAC+1 STACK BYTE 1 10384 2890:70A0 SB @270D,R2 SUBTRACT @>270D FROM R2 (CURRENT CHAR) 10388 2894:0203 LI R3,>0002 SET Y CHR TO 2 10390 2896:0002 10392 2898:10F2 JMP JM12 JM11 10394 289A:D8C2 MOVB R2,@FAC(R2) STACK BYTE 0 INDEX R2 10398 289E:0420 BLWP @NUMASG PUT CURRENT CHAR (R2) AT ARGUEMENT 4 10402 28A2:045B B *R11 RETURN Edited July 3 by Artoj 2 2 Quote Link to comment https://forums.atariage.com/topic/366288-old-graphic-xb-program/#findComment-5494961 Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.