10 REM Copyright (C) 2022 L.C. Benschop, The Netherlands 20 REM You are free to copy and use this program under the 'zlib' license 30 REM v0.01 (unnumbered) initial version 40 REM v0.02 let Y coordinate start at bottom, add more figures. 50 REM v0.03 Add more figures, use more chars on Cerberus 60 REM v0.04 Add erase and and invert modes, add introduction. 70 REM v0.06 Use shared character codes and hash tables. 80 ON ERROR GOTO 2060 90 cerb%=PAGE < 65536 100 REM If not on Cerberus hardware, reserve areas for video RAM and char RAM 110 REM If on Cerberus hardware, use video RAM and character RAM addresses directly. 120 IF cerb%=0 THEN MODE4:DIM cmem% 2047:DIM vmem% 1199:ELSE cmem%=&F000:vmem%=&F800 130 DIM bmaps% 7 140 DIM refcnt%(255): REM reference count for each character. 150 DIM hashtab% 255: REM hash table to relate character patterns to code 160 DIM hashlink% 255: REM link characters with same hash bucket. 170 DIM chars% 255:REM Array of characters available for plotting 180 fc%=91: REM Utilize character codes from fc% to 255. 190 v%=1 200 FOR i% = 7 TO 0 STEP -1 210 bmaps%?i%=v% 220 v%=v%+v% 230 NEXT 240 CLS 250 PRINT TAB(5,0);"CERBERUS2080 Graphics Demo" 260 PRINT TAB(0,2);"Copyright 2022 L.C. Benschop" 270 PRINT "The Netherlands" 280 PRINT 290 PRINT "You are free to copy, modify and use" 300 PRINT "this program under the 'zlib' license." 310 PRINT "You are encouraged to create other" 320 PRINT "programs using the PROCplotdot and" 330 PRINT "PROCdrawline procedures." 340 PRINT 350 PRINT "CERBERUS2080 supports text mode with" 360 PRINT "256 different redefinable 8x8 pixel" 370 PRINT "characters." 380 PRINT 390 PRINT "It is possible to plot dots and lines by"; 400 PRINT "redefining the characters on the fly." 410 PRINT "This progran is written entirely in" 420 PRINT "BASIC, therefore it is not very fast." 430 PRINT "It will be possible to speed it up by" 440 PRINT "rewriting the graphics primitives in" 450 PRINT "assembler." 460 PRINT TAB(0,29);"Press any key to continue...";:A$=INKEY$(3000):CLS 470 PRINT TAB(12,0);"LIMITATIONS" 480 PRINT TAB(0,2);"It is not possible to draw arbitrarily" 490 PRINT "complex patterns, because the screen" 500 PRINT "contains 1200 character cells and there" 510 PRINT "are only 256 different characters." 520 PRINT "However, you can still draw interesting" 530 PRINT "graphs as this demo will show." 540 PRINT 550 PRINT "Also, if you restrict your drawing area" 560 PRINT "to a small enough subset of the screen" 570 PRINT "you can draw arbitrary patterns there." 580 PRINT 590 PRINT "Characters 0..31 and 91..255 can be" 600 PRINT "used, leaving the ASCII capitals intact."; 610 PRINT "This program can erase drawn lines and" 620 PRINT "characters are freed when the character" 630 PRINT "cell becomes completely empty." 640 PRINT 650 PRINT "This program shares characters between" 660 PRINT "cells with the same bitmap. A long" 670 PRINT "horizontal line takes just one character" 680 PRINT "You can draw grids of horizontal and" 690 PRINT "vertical lines." 700 PRINT 710 PRINT "After each demo screen the bottom line" 720 PRINT "shows the number of available chars to" 730 PRINT "redifine." 740 PRINT TAB(0,29);"Press any key to start demo...";:A$=INKEY$(3000) 750 PROCclearscreen 760 REM draw some lines 770 PRINT TAB(15,0);"LONG LINES" 780 PROCdrawline(0,8,319,231,1) 790 PROCdrawline(0,120,319,120,1) 800 PROCdrawline(250,8,150,231,1) 810 PROCdrawline(160,8,160,231,1) 820 PROCnextscreen 830 REM Draw a grid of lines. 840 PRINT TAB(10,0);"GRID OF LINES" 850 FOR i%=10 TO 230 STEP 10 860 PROCdrawline(0,i%,310,i%,1) 870 NEXT 880 FOR i%=0 TO 310 STEP 10 890 PROCdrawline(i%,10,i%,230,1) 900 NEXT 910 FOR i%=1 TO 10 920 x1%=RND(320)-1:y1%=7+RND(223):x2%=RND(320)-1:y2%=7+RND(223) 930 PROCdrawline(x1%,y1%,x2%,y2%,2) 940 A$=INKEY$(100) 950 PROCdrawline(x1%,y1%,x2%,y2%,2) 960 NEXT 970 PROCnextscreen 980 REM Draw some random triangles 990 PRINT TAB(10,0);"RANDOM TRIANGLES" 1000 FOR i%=0 TO 5 1010 x1%=50+RND(200):y1%=40+RND(160) 1020 x2%=50+RND(200):y2%=40+RND(160) 1030 x3%=50+RND(200):y3%=40+RND(160) 1040 PROCdrawline(x1%,y1%,x2%,y2%,1) 1050 PROCdrawline(x2%,y2%,x3%,y3%,1) 1060 PROCdrawline(x3%,y3%,x1%,y1%,1) 1070 NEXT 1080 PROCnextscreen 1090 PRINT TAB(10,0);"ERASE RANDOM LINES" 1100 FOR i%=1 TO 10 1110 x1%=RND(320)-1:y1%=7+RND(223):x2%=RND(320)-1:y2%=7+RND(223) 1120 PROCdrawline(x1%,y1%,x2%,y2%,1) 1130 A$=INKEY$(100) 1140 PROCdrawline(x1%,y1%,x2%,y2%,0) 1150 NEXT 1160 PROCnextscreen 1170 REM draw squares under different angles. 1180 PRINT TAB(5,0);"36 SQUARES AT DIFFERENT ANGLES" 1190 FOR phi=0 TO 350 STEP 10 1200 x%=160:y%=120:ox%=x%:oy%=y% 1210 phi2 = phi 1220 FOR s%=1 TO 4 1230 x%=x%+INT(SIN(RAD(phi2))*40+0.5) 1240 y%=y%+INT(COS(RAD(phi2))*40+0.5) 1250 PROCdrawline(ox%,oy%,x%,y%,1) 1260 phi2=phi2+90 1270 ox%=x%:oy%=y% 1280 NEXT 1290 NEXT 1300 PROCnextscreen 1310 REM draw squares under different angles. 1320 PRINT TAB(5,0);"12 SQUARES AT DIFFERENT ANGLES" 1330 FOR phi=0 TO 330 STEP 30 1340 x%=160:y%=120:ox%=x%:oy%=y% 1350 phi2 = phi 1360 FOR s%=1 TO 4 1370 x%=x%+INT(SIN(RAD(phi2))*60+0.5) 1380 y%=y%+INT(COS(RAD(phi2))*60+0.5) 1390 PROCdrawline(ox%,oy%,x%,y%,1) 1400 phi2=phi2+90 1410 ox%=x%:oy%=y% 1420 NEXT 1430 NEXT 1440 PROCnextscreen 1450 REM draw a sine curve one dot at at time. 1460 PRINT TAB(10,0);"SINE CURVE WITH DOTS" 1470 FOR x%=0 TO 319 1480 y%=120+70*SIN(x%/20) 1490 PROCplotdot(x%,y%,1) 1500 NEXT 1510 PROCnextscreen 1520 REM draw the same curve with line segments 1530 PRINT TAB(10,0);"SINE CURVE WITH LINES" 1540 FOR x%=0 TO 319 STEP 5 1550 y%=120+70*SIN(x%/20) 1560 IF x%>0 THEN PROCdrawline(oldx%,oldy%,x%,y%,1) 1570 oldy%=y%:oldx%=x% 1580 NEXT 1590 PROCnextscreen 1600 REM draw a different curve (sine plus second harmonic) 1610 PRINT TAB(5,0);"SINE CURVE WITH SECOND HARMONIC" 1620 FOR x%=0 TO 319 STEP 5 1630 y%=120+70*SIN(x%/20)+20*SIN(x%/10+1) 1640 IF x%>0 THEN PROCdrawline(oldx%,oldy%,x%,y%,1) 1650 oldy%=y%:oldx%=x% 1660 NEXT 1670 PROCnextscreen 1680 REM draw a different curve (damped sine wave) 1690 PRINT TAB(5,0);"DAMPED SINE CURVE" 1700 FOR x%=0 TO 319 STEP 2 1710 y%=120+120*SIN(x%/10)*EXP(-x%/60) 1720 IF x%>0 THEN PROCdrawline(oldx%,oldy%,x%,y%,1) 1730 oldy%=y%:oldx%=x% 1740 NEXT 1750 PROCnextscreen 1760 REM draw a 'lissajous' shape (x=4th harmonic, y=3rd harmonic) 1770 PRINT TAB(10,0);"LISSAJOUS FIGURE" 1780 oldx%=-1:oldy%=-1 1790 FOR t=0 TO 2*PI+0.01 STEP PI/50 1800 x%=160+INT(70*SIN(4*t)+0.5) 1810 y%=120+INT(70*COS(3*t)+0.5) 1820 IF oldx%>=0 THEN PROCdrawline(oldx%,oldy%,x%,y%,1) 1830 oldx%=x%:oldy%=y% 1840 NEXT 1850 PROCnextscreen 1860 REM draw a spiral 1870 PRINT TAB(15,0);"SPIRAL" 1880 oldx%=-1:oldy%=-1 1890 FOR t=0 TO 18*PI STEP 0.2 1900 x%=160+t*SIN(t) 1910 y%=120+t*COS(t) 1920 IF oldx%>=0 THEN PROCdrawline(oldx%,oldy%,x%,y%,1) 1930 oldx%=x%:oldy%=y% 1940 NEXT 1950 PROCnextscreen 1960 REM And now the XOR-lines pattern is a small rectangle. 1970 PRINT TAB(10,0);"OVERSTRIKE LINE PATTERN" 1980 dx%=128:dy%=80 1990 FOR i%=0 TO dx%-1 2000 FOR j%=0 TO dx%-1 2010 PROCdrawline(96+i%,40,96+j%,40+dy%,2) 2020 NEXT 2030 NEXT 2040 PROCnextscreen 2050 REM restore the character set. 2060 IF cerb% OSCLI"LOAD chardefs.bin &F000":CLS ELSE MODE 4 2070 REPORT:PRINT " at ";ERL:END 2080 DEF PROCnextscreen 2090 PRINT TAB(0,29);ctop%;" FREE CHARS. PRESS KEY TO CONTINUE";:A$=INKEY$(500) 2100 PROCclearscreen 2110 ENDPROC 2120 REM graphics procedures 2130 REM 2140 REM Clear the screen and definable characters. 2150 DEF PROCclearscreen 2160 LOCAL i% 2170 CLS 2180 REM Cerberus also allows character codes 0..31 2190 ctop%=0 2200 IF cerb% THEN FOR i%=0 TO 31:chars%?ctop% = i%:ctop% = ctop%+1:NEXT 2210 FOR i%=fc% TO 255 2220 IF i%<>127 OR cerb% THEN chars%?ctop% = i%:ctop%=ctop%+1 2230 NEXT 2240 FOR i%=0 TO 255 STEP 4 2250 cmem%!i% = 0 2260 NEXT 2270 FOR i%=fc%*8 TO 2047 STEP 4 2280 cmem%!i% = 0 2290 NEXT 2300 FOR i%=0 TO 255 STEP 4 2310 hashtab%!i%=&20202020 2320 hashlink%!i%=&20202020 2330 NEXT 2340 FOR i%=0 TO 255 2350 refcnt%(i%)=0 2360 NEXT 2370 lastchar%=1200 2380 IF cerb% THEN ENDPROC 2390 FOR i%=0 TO 1199 STEP 4 2400 vmem%!i% = &20202020 2410 NEXT 2420 ENDPROC 2430 REM Plot a single dot at x,y 2440 DEF PROCplotdot(x%,y%,v%) 2450 IF (x% AND &FFFF) > 319 OR (y% AND &FFFF) > 239 THEN ENDPROC 2460 LOCAL cr%,cc%,cn%,addr%,base%,i%,charcell%,c2%,oldbase% 2470 cy%=(239-y%) DIV 8 2480 cx%=x% DIV 8 2490 charcell%=cy%*40+cx% 2500 IF charcell%=lastchar% THEN cn% = vmem%?charcell%:GOTO 2690:REM Working on same char cell as last time 2510 cn%=vmem%?lastchar%:IF lastchar%>1199 OR (cn%>=32 AND cn%=0 THEN refcnt%(c2%)=refcnt%(c2%)+1: base%!0=0:base%!4=0:chars%?ctop%=cn%:ctop%=ctop%+1:refcnt%(cn%)=0:vmem%?lastchar%=c2% ELSE PROCaddhash(cn%,base%) 2590 REM done with the character in lastchar%: either freed & replaced with identical character, or added to table. 2600 lastchar%=charcell%:cn% = vmem%?charcell% 2610 IF refcnt%(cn%)=1 THEN base%=cmem%+8*cn%:PROCremhash(cn%,base%):GOTO 2690:REM Definable character already there, only used once 2620 IF ctop%=0 THEN lastchar%=1200:ENDPROC:REM No more characters available. 2630 REM Reserve a new character. 2640 c2%=cn% 2650 ctop%=ctop%-1:cn%=chars%?ctop%:refcnt%(cn%)=1 2660 base% = cmem%+8*cn% 2670 REM if original character at this position was shared, copy bitmap into new one, decrease ref count 2680 IF refcnt%(c2%)>0 THEN refcnt%(c2%)=refcnt%(c2%)-1:oldbase%=cmem%+8*c2%:!base%=!oldbase%:base%!4=oldbase%!4 2690 base%=cmem%+8*cn%:addr% = base% + 7 - y% MOD 8 2700 REM Set/clear/invert the desired dot in the character memory. 2710 IF v%=1 THEN ?addr% = ?addr% OR bmaps%?(x% MOD 8) ELSE IF v%=0 THEN ?addr% = ?addr% AND NOT bmaps%?(x% MOD 8) ELSE ?addr% = ?addr% EOR bmaps%?(x% MOD 8) 2720 vmem%?charcell%=cn% 2730 IF cerb% THEN ENDPROC 2740 REM If not on cerberus hardware, redefine the character 2750 REM and print it on the screen at desired position. 2760 REM On Cerberus we operate on char and video RAM directly 2770 VDU 23,cn% 2780 FOR i%=0 TO 7 2790 VDU cmem%?(8*cn%+i%) 2800 NEXT 2810 VDU 31,cx%,cy%,cn% 2820 ENDPROC 2830 REM find character with bitmap in base% in hashtable. 2840 DEFFNfindhash%(base%) 2850 LOCAL c%,b% 2860 c%=hashtab%?FNhash%(base%) 2870 IF c%=32 THEN =-1 2880 b%=cmem%+8*c%:IF !b%=!base% AND b%!4 = base%!4 THEN =c% 2890 c%=hashlink%?c%:GOTO 2870 2900 REM add character with given code and bitmap to hashtable. 2910 DEF PROCaddhash(c%,base%) 2920 LOCAL h%,c1%,c2% 2930 h%=FNhash%(base%) 2940 c1%=hashtab%?h%:IF c1%=32 THEN hashtab%?h%=c%:hashlink%?c%=32:ENDPROC 2950 IF c1%=c% THEN ENDPROC 2960 c2%=hashlink%?c1%:IF c2%=32 THEN hashlink%?c1%=c%:hashlink%?c%=32:ENDPROC 2970 c1%=c2%:GOTO2950 2980 ENDPROC 2990 REM remove character with given code and bitmap from hashtable 3000 DEF PROCremhash(c%,base%) 3010 LOCAL h%,c1%,c2% 3020 h%=FNhash%(base%) 3030 c1%=hashtab%?h%:IF c1%=c% THEN c1%=hashlink%?c1%:hashtab%?h%=c1%:ENDPROC 3040 IF c1%=32 THEN ENDPROC 3050 c2%=hashlink%?c1%:IF c2%=c% THEN hashlink%?c1%=hashlink%?c2%:ELSE c1%=c2%:GOTO3050 3060 ENDPROC 3070 REM hash function map 64-bit bitmap to 8-bit hash code. 3080 DEF FNhash%(base%)=(2187*?base% + 729*base%?1 + 243*base%?2 + 81*base%?3 + 27*base%?4 + 9*base%?5 + 3*base%?6 + base%?7) MOD 257 AND 255 3090 REM draw line between points x1,y1 and x2,y2 3100 DEFPROCdrawline(x1%,y1%,x2%,y2%,v%) 3110 LOCAL dx%,dy%,xs%,ys%,t%,i%,j% 3120 dx%=2*ABS(x1%-x2%) 3130 dy%=2*ABS(y1%-y2%) 3140 ys%=1+2*(y2%dx% THEN GOTO 3260 3170 REM draw line one step in x direction 3180 t%=-(dx% DIV 2) 3190 j%=y1% 3200 FOR i%=x1% TO x2% STEP xs% 3210 PROCplotdot(i%,j%,v%) 3220 t%=t% + dy% 3230 IF t%>0 THEN j%=j%+ys%:t%=t%-dx% 3240 NEXT 3250 ENDPROC 3260 REM draw line one step in y direction 3270 t%=-(dy% DIV 2) 3280 j%=x1% 3290 FOR i%=y1% TO y2% STEP ys% 3300 PROCplotdot(j%,i%,v%) 3310 t%=t% + dx% 3320 IF t%>0 THEN j%=j%+xs%:t%=t%-dy% 3330 NEXT 3340 ENDPROC