witzo
Windows User
Posts: 19
|
Post by witzo on Oct 5, 2014 20:04:22 GMT
I've made small letters in Basic, putting four in one attribute cell on the graphics screen. It's very slow, I've been using VICE's warp mode all the time. Rather stream-of-consciousness coding, adding bits here and there to make frames for the text and some other stuff. 0 rem **** 041014 hi!ware **** 2 rem >petcat -w70 -o kleineletters.prg -- kleineletters.bas 4 rem *** init screen, function *** 6 color0,9:rem achtergrondkleur grafisch scherm moet voor graphic1,1 8 graphic1,1:rem basic verplaatsen voordat deffn gedaan wordt 10 deffn sp(b)=y*40+x 12 deffn rd(a)=int(rnd(1)*a) 14 goto1000 16 rem *** letter: teken kleine letter u op v,w *** 50 if v<0 or v>79 then return 52 if w<0 or w>49 then return 54 p=v:q=w 56 lr=1:ob=0 58 if(v and 1)=1 thenlr=0:p=p-1 60 if(w and 1)=1 thenob=1:q=q-1 62 x=int(p/2):y=int(q/2):d=fnsp(x) 64 rem rechtsboven 66 if lr=0 and ob=0 then begin 68 fori=0to3 70 f=a%(u,i):g=peek(e+8*d+i):g=g and 240:g=g or f:poke e+8*d+i,g 72 nexti 74 bend 76 rem linksboven 78 if lr=1 and ob=0 then begin 80 fori=0to3 82 f=a%(u,i):f=f*16:g=peek(e+8*d+i):g=g and 15:g=g or f:poke e+8*d+i,g 84 nexti 86 bend 88 rem rechtsonder 90 if lr=0 and ob=1 then begin 92 fori=0to3 94 f=a%(u,i):g=peek(e+8*d+4+i):g=g and 240:g=g or f:poke e+8*d+4+i,g 96 nexti 98 bend 100 rem linksonder 102 if lr=1 and ob=1 then begin 104 fori=0to3 106 f=a%(u,i):f=f*16:g=peek(e+8*d+4+i):g=g and 15:g=g or f:poke e+8*d+4+i,g 108 nexti 110 bend 112 return 114 rem *** kleurcel: kleur attribute cell *** 116 rem loc. x 0..39 ,y 0..24 met kleur k voor- en l achtergrond 118 rem hi nibble is voor, low nibble is achter. 300 d=fnsp(x):pokec+d,(k*16)+l:return 302 rem *** kleur lengte van string *** 320 y=int(w/2) 322 forx=(v/2)to(v+m)/2 324 gosub 300 326 nextx 328 return 330 rem *** kader: kleuren in en rond tekstblok *** 332 rem in: b%(0..3),c%(0..5),k,l 334 rem *lijnrand en celrand* 400 box0,b%(0)*8-2,b%(1)*8-2,(b%(2)+1)*8+1,(b%(3)+1)*8+1,0,1 402 box1,b%(0)*8-1,b%(1)*8-1,(b%(2)+1)*8,(b%(3)+1)*8 404 box1,b%(0)*8-3,b%(1)*8-3,(b%(2)+1)*8+2,(b%(3)+1)*8+2 406 rem *border* 408 forx=b%(0)-1tob%(2)+1 410 k=c%(0):l=c%(1):y=b%(1)-1 412 gosub 300 414 k=c%(2):l=c%(3):y=b%(3)+1 416 gosub 300 418 nextx 420 fory=b%(1)tob%(3) 422 k=c%(0):l=c%(1):x=b%(0)-1 424 gosub 300 426 k=c%(2):l=c%(3):x=b%(2)+1 428 gosub 300 430 nexty 432 rem *tekstblok* 434 k=c%(4):l=c%(5) 436 forx=b%(0)tob%(2) 438 fory=b%(1)tob%(3) 440 gosub 300 442 nexty 444 nextx 446 return 448 rem *** tekststring *** 450 rem in: b$ v(0..79),w(0..49) 500 forj=1tolen(b$) 502 c$=mid$(b$,j,1):u=asc(c$)-32:gosub 50:v=v+1 504 nextj 506 return 508 rem *** main *** 1000 color1,2:rem tekenen in een willekeurige voorgrondkleur 1002 poke828,183 : rem functietoetsen herkenbaar met chr$(133enz.) 1004 c=7168 1006 e=8192 1008 dima%(58,3) 1010 fast 1012 rem lees karakterdefinities 1014 fori=0to58 1016 forj=0to3 1018 readh 1020 a%(i,j)=h 1022 nextj 1024 nexti 1026 slow 1028 rem kleurnummers 1030 y=24:k=1 1032 forx=0to15 1034 l=x 1036 k=(x+1)and15 1038 gosub 300 1040 nextx 1042 v=0:w=49 1044 b$="0 1 2 3 4 5 6 7 8 9 101112131415" 1046 gosub 500 1048 rem tekstjes 1050 b%(0)=4:b%(1)=10:b%(2)=18:b%(3)=11 1052 c%(0)=8:c%(1)=9:c%(2)=10:c%(3)=2 1054 c%(4)=13:c%(5)=5 1056 gosub 400 1058 v=9:w=21 1060 b$=" !"+chr$(34)+"#$%&'()*+,-./0123456789" 1062 gosub 500 1064 v=9:w=22 1066 b$=":;<=>?@" 1068 gosub 500 1070 v=9:w=23 1072 b$="abcdefghijklmnopqrstuvwxyz" 1074 gosub 500 1076 b%(0)=24:b%(1)=5:b%(2)=33:b%(3)=14 1078 c%(0)=14:c%(1)=11:c%(2)=3:c%(3)=15 1080 c%(4)=7:c%(5)=2 1082 gosub 400 1084 v=51:w=12 1086 b$="hi!ware 2014" 1088 gosub 500 1090 v=48:w=15 1092 b$="c-128.freeforums.net" 1094 gosub 500 1096 v=49:w=17 1098 b$="available commands:" 1100 gosub 500 1102 v=49:w=19 1104 b$="- letter" 1106 gosub 500 1108 v=49:w=21 1110 b$="- kleurcel" 1112 gosub 500 1114 v=49:w=23 1116 b$="- kader" 1118 gosub 500 1120 v=49:w=25 1122 b$="- chaos" 1124 gosub 500 1126 v=49:w=27 1128 b$="f1: exit" 1130 gosub 500 1132 rem *** tekst intypen *** 1134 b%(0)=4:b%(1)=15:b%(2)=18:b%(3)=15 1136 c%(0)=4:c%(1)=6:c%(2)=10:c%(3)=9 1138 c%(4)=3:c%(5)=8 1140 gosub 400 1142 v=8:w=30:c$="" 2000 do 2002 u=3:gosub50:rem cursor 2004 getkeya$ 2006 z=asc(a$) 2008 if z>=32 and z<=90 then gosub 2100:rem karakters 2010 ifz=20then gosub 2120:rem delete 2012 ifz=13then gosub 2140:rem return 2014 ifz=133then exit:rem asc1 exit 2016 loop 2018 printc$:graphic0,0 2020 print"einde" 2022 end 2024 rem ** getypte karakters, delete, return ** 2100 c$=c$+a$:u=z-32:gosub 50:v=v+1: 2102 ifv>37thenv=37:c$=left$(c$,37):rem tot charpos 37 chars 2104 return 2120 u=0:gosub50:v=v-1:ifv=<8thenv=8 2122 iflen(c$)>0then c$=left$(c$,len(c$)-1) 2124 gosub 50 2126 return 2140 u=0:gosub50 2142 v=8:w=31:u=42-32:gosub50 2144 rem doe iets met invoer 2146 if left$(c$,6)="letter" then gosub 2500 2148 if left$(c$,8)="kleurcel" then gosub2600 2150 if left$(c$,5)="kader" then gosub 2700 2152 if left$(c$,5)="chaos" then begin 2154 for j=1to10 2156 on fnrd(3)+1 gosub 2500, 2600, 2700 2158 nextj 2160 bend 2162 c$="" 2164 remgetkeya$ 2166 box0,8*4,30*4,(38*4)-1,(32*4)-1,0,1:rem wis tekst 2168 v=8:w=30 2170 return 2172 rem ** random letters, kleurcellen en kaders ** 2500 u=fnrd(57)+1:v=fnrd(79):w=fnrd(49) 2502 gosub50 2504 return 2600 x=fnrd(40):y=fnrd(25):k=fnrd(16):l=fnrd(16) 2602 gosub 300 2604 return 2700 b%(0)=fnrd(38)+1:b%(1)=fnrd(22)+1:b%(2)=fnrd(38-b%(0))+b%(0):b%(3)=fnrd(22-b%(1))+b%(1) 2702 c%(0)=fnrd(16):c%(1)=fnrd(16):c%(2)=fnrd(16):c%(3)=fnrd(16) 2704 c%(4)=fnrd(16):c%(5)=fnrd(16) 2706 gosub 400 2708 return 2710 rem *** ascii 32 spatie t/m 90 z *** 2712 data 0,0,0,0, 4,4,0,4, 10,0,0,0, 0,10,0,10 2714 data 6,12,8,6, 10,2,4,5, 2,7,10,5, 4,0,0,0 2716 data 4,8,8,4, 8,4,4,8, 0,10,4,10, 0,4,14,4 2718 data 0,0,2,4, 0,0,14,0, 0,0,0,4, 2,2,4,4 2720 data 4,10,10,14, 4,12,4,14, 12,2,4,14, 14,2,6,14 2722 data 10,10,6,2, 14,8,6,14, 6,8,14,14, 14,2,4,4 2724 data 4,10,14,14, 4,10,6,2, 0,4,0,4, 4,0,4,8 2726 data 0,4,8,4, 0,12,0,12, 0,8,4,8, 14,2,0,4 2728 data 12,6,10,4 2730 data 4,10,14,10, 14,12,10,12, 6,8,8,6, 12,10,10,12, 14,12,8,14, 14,12,8,8, 6,8,10,6 2732 data 10,14,10,10, 14,4,4,14, 2,2,10,4, 10,12,10,10, 8,8,8,14, 15,15,9,9, 10,14,14,10 2734 data 4,10,10,4, 12,10,12,8, 4,10,14,6, 12,10,12,10, 6,12,6,12, 14,4,4,4, 10,10,10,14 2736 data 10,10,10,4, 9,9,6,6, 10,4,10,10, 10,4,4,4, 14,4,8,14 2738 rem lr: 1 rgrinks, 0 hex$echts 2740 rem ob: 1 joynder, 0 peekoven 2742 rem sp: fn schermrdotositie = functie x,y 0..39, 0..24 2744 rem rd: fn random nummer 0..a-1, functie rd(a)=int(rnd(1)*a) 2746 rem a: var voor functies 2748 rem b: dummy var voor functies met lege (); mogelijke tijdelijke var 2750 rem c: screen (colour) mem start 7168 2752 rem d: nummer van attribuutcel, verkregen uit fn sp met x0..39,y0..24 2754 rem e: start bitmap 8192 2756 rem f: 1 karakternibble 2758 rem g: inhoud van te wijzigen bitmapgeheugenlocatie 2760 rem h: gelezen byte uit data 2762 rem i: lusteller in letter (regel 50) 2764 rem j: lusteller elders 2766 rem k, l: voorgrondkleur k, achtergrondkleur l 2768 rem m: 2770 rem n: lusteller kleur lengte van string 2772 rem o: x-positie van volgende letter 0..79 2774 rem p, q: kopie van v, w voor bepaling lr en ob 2776 rem u: nummer van te tekenen karakter 2778 rem v, w: schermpositie 0..79, 0..49 2780 rem x, y: schermpositie attribuutcel 0..39, 0..24 2782 rem z: asciiwaarde van ingetypte teken 2784 rem a%(57,3): karakterarray (0..57,0..3) 2786 rem b%(0..3): x1,y1 en x2,y2 van tekstblok 0..39, 0..24 2788 rem c%(0..3): k1,l1,k2,l2 voor- en achtergrondkleuren kaders 2790 rem c%(4 en 5): k voor- en l achtergrondkleur tekstblok 2792 rem a$: toetsaanslag 2794 rem b$: te printen tekststring 2796 rem c$: ingetypte tekst
|
|