Color WHAT?

Blitz3D Forums/Blitz3D Programming/Color WHAT?

Jimmy (Posted 2011) [#1]

This is something odd, not for everyday joe, but for anyone who wishes to explore the strange world FORTH. Not any FORTH but the newest FORTH - ColorFORTH, its not an emulator this time it is an browser for looking at the source code. Something I did few years ago, as major progress with Cartador happened today. I am also releasing this I made for Charles Moore ColorFORTH, it is a dialect used for his new mobile low power but massively parallel chips. If you find it interrsting you could download it from Chucks site www.colorFORTH.com I need to provide sourcecode too but I have to ask Chuck for this. Till then I think colorforth.com and some places on the web already offers colorforth binaries. This eats ColorFORTH binaries and show it onscreen in its proper style. This is not a final version but my personal workhorse, and I withstand any defect it may have I have personally found none, but just in case anyone finds one, Its provided to learn how it are build up. Version 2 lays on the desk waiting, looking more smashing than this. But as I am happy today about CartAdore emulator I might release this aswell. Most of you won't be interested , this is for the few that are. Pick a full ColorFORTH up if you are intruiged. I want this to be an interest bridge and you get to see it inside out. Sorry I cannot provide a binary here at it is, I provide a link instead. http://www.dnd.utwente.nl/~tim/colorforth/cfinal/ http://www.colorforth.com Look for a color.bin. Last note, this is odd thing, it might need a longer explanation but as of now I leave it up to Chuck at colorforth.com to epxlain. I will try to further later! I also wrote an article but It's not in shape to be release yet, and abit short of time to finish it right now. Cheerio, this old man needs some sleep! ; ----------------------- ; ColorFORTH code Browser ; ; By Jimmy ; ; Verision 1, ; Public domain 2003 ; ----------------------- ; This is bare bones showing how to access ColorFORTH code. ; You could use this improving your understanding of how it works. ; There's lot of room for improvement and ideas for doing things with it. ; This is the first version, intended for learning purposes but still fully functional. ; And does read any ColorFORTH code you feed it. ; ------------------------------------------------------------------------------- ; 48 chars.. each character has 6 bit index (64 characters) into a graphics table ; 48 standard letters and symbols + 26 capital letters + 12 graphicssymbols ; 16 x 24 bitmaps, size is emit? Graphics 640,480,16 SetBuffer BackBuffer() Global word Global word2 Global txt$ Global cursor Global row ; load a (max 256KB) .blk file into RAM() array, i then contains how many 32bit words. Dim ram(65535*100) filehandle=ReadFile ("Color.bin"); ("OkadWork.cf") i=0 Repeat ram(i)=ReadInt(filehandle) i=i+1 Until Eof(filehandle) CloseFile (filehandle) cursor=0 row=0 ; show 2 blocks (256 32bit words Each) (32 bit numbers and remark/word/variablename using extension (extension itself chained?!)) b=0 comment=0 Repeat Cls:cursor=0:row=0:Color 64,64,64:Text cursor*8,row*16,"Block "+Str$(b+comment):row=row+2 ;Color 64,64,64:Text 0,10,"Block "+Str$(b) i=(b+comment)*256 ; first NULL in every block correct end-of-block marker? .loop word=ram(i) If word=0 Then Goto skip ;fetch next word and next word2=ram(i+1) Select word And 15 ; check its function (bits 0-3) Case 1 Color 255,255,0:tex() ; TEXT (YELLOW) Case 4 Color 0,255,0:tex() ; TEXT (GREEN) Case 7 Color 0,255,255:tex() ; TEXT (CYAN) Case 3 cursor=0:row=row+1:Color 255,0,0:tex() ; TEXT (RED) Case 12 Color 255,0,255:tex():i=i+1:Color 255,255,255:num32() ; TEXT (MAGENTA) Case 9 Color 255,255,255:tex() ; TEXT (WHITE,lower) Case 10 Color 255,255,255:tex() ; TEXT (WHITE,Capitalized) Case 11 Color 255,255,255:tex() ; TEXT (WHITE,UPPER) Case 8 Color 255,255,0:num27() ; 27BITNUMBER (YELLOW) Case 6 Color 0,255,0:num27() ; 27BITNUMBER (GREEN) Case 2 Color 255,255,0:num32():i=i+1 ; 32BITNUMBER (YELLOW) Case 5 Color 0,255,0:num32():i=i+1 ; 32BITNUMBER (GREEN) ; remarks 3 modes Case 0 cursor=cursor-1:tex() ; EXTENSION (follows TEXT word, to make it possible to be longer) Default ;Color 100,100,100:Text cursor*8,row*16,"**********":cursor=cursor+12 ; 13-15 not used End Select If cursor>64 Then cursor=0:row=row+1 i=i+1 Goto loop .skip If KeyDown(208) Then comment=0:b=b-2:VWait:VWait:VWait:VWait:VWait:If b<0 Then b=0 If KeyDown(200) Then comment=0:b=b+2:VWait:VWait:VWait:VWait:VWait If KeyDown(57) Then comment=1-comment:VWait:VWait:VWait:VWait:VWait Flip Until MouseDown(2) End Function tex() txt$="" ;table$=" rtoeanismcylgfwdvpbhxuq0123456789j-k.z/;:!+@*,?" table$=" RTOEANISMCYLGFWDVPBHXUQ0123456789J-K.Z/;:!+@*,?" chars=(word Shr 4) Shl 4; clear bits 0-3 Repeat ; IF bit 31=0 (4BIT) ; (IF chars And %10000000000000000000000000000000 = %00000000000000000000000000000000) ; (IF Signflag is cleared) If chars=>0 c=chars Shr 28 chars=chars Shl 4 Goto skip EndIf ; IF bit 31=1 AND bit 30=0 (5BIT) ; (IF chars And %11000000000000000000000000000000 = %10000000000000000000000000000000) ; (IF sign is set and ?) If Mid$(Bin$(chars),1,2)="10" c=chars Shr 27 c=c And 7 c=c+8 chars=chars Shl 5 Goto skip EndIf ; IF NONE ABOVE (7BIT) c=chars c=c Shr 28 c=c-10 c=c Shl 3 r7=chars Shr 25 r7=r7 And 7 c=c+r7 chars=chars Shl 7 .skip txt$=txt$+Mid$(table$,c+1,1) Until chars=0 Text cursor*8,row*16,txt$:cursor=cursor+Len(txt$)+1 End Function Function num27() ; sign extension handled correctly? ; hex (non NULL means hex) number=word Sar 5 hexflag=(word And 16) Text cursor*8,row*16,Str$(number):cursor=cursor+Len(Str$(number))+1 ;If hexflag=0 Then Text cursor*8,row*16,Str$(number):cursor=cursor+Len(Str$(number))+1 ;If hexflag<>0 Then Text cursor*8,row*16,Hex$(Str$(number)):cursor=cursor+Len(Hex$(Str$(number)))+1 End Function Function num32() ; hex number=word2 hexflag=(word And 16) Text cursor*8,row*16,Str$(number):cursor=cursor+Len(Str$(number))+1 ;If hexflag=0 Then Text cursor*8,row*16,Str$(number):cursor=cursor+Len(Str$(number))+1 ;If hexflag<>0 Then Text cursor*8,row*16,Hex$(Str$(number)):cursor=cursor+Len(Hex$(Str$(number)))+1 End Function Last edited 2011 Last edited 2011 Last edited 2011 Last edited 2011 Last edited 2011

Yasha (Posted 2011) [#2]

This is pretty cool. I'd never looked at Forth before, so thanks for the reminder. It's a fascinating language. No idea what I'm looking at, but cool nonetheless.