Old graphic XB program

[Artoj]

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

[Artoj]

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

 

[Artoj]

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.

[Artoj]

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.

[+OLD CS1]

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?

[Artoj]

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.

 

 

[+arcadeshopper]

i'll not TIPI has a nice color epson emulation in its PI.PIO printing system

thanks for sharing the program

[Artoj]

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.    

[Artoj]

Hi All,

Here is the complete program as a TEXT file, I will start on the MiniMem version shortly. Regards Arto.

 

TIDraw1a

[Artoj]

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

[Artoj]

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.     

[Artoj]

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

[Artoj]

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

[+OLD CS1]

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?

[Artoj]

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.

[Artoj]

Hi All,

Here is the Program and TXT listing, regards Arto

XBDRAW2 TIDraw2a.txt

[Artoj]

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