; bitmap font editor script by Aiet Kolkhi . 1999 ;The bitmap font editor. This is WinBatch file and requires ;Wilson WindowWare WinBatch. The demo version of WinBatch for Windows ;can be downloaded from: http://www.windowware.com ;This batch file allows viewing and editing of 8x14 size linux ;console fonts. Create a file with exactly 2564 bytes and click on ;"load font" to edit it. ;The dile has one big BUG! if you switch to another windows application ;while working eith this batsh file, it may exit without saing goodbye! ;so it's good idea to save you work (click on "save font") frequently! ;NOTE that clicking on "save char" just saves character to buffer and ;therefore is not safe! ;This is a free batch file and may be distributed free of charge. ;No responsibility is taken for any damage caused by the batch file! ;If you have any questions or suggestions: Aiet ;~~~~~~~~~~~~~~~~create box~~~~~~~~~~~~~~~~~~~ backup=9 fold="C:\" fopen=0 boxdrawn=0 bOfont=1 bExit=2 bPrev=3 bNext=4 bGoto=5 bSaveChar=6 bSaveFont=7 saveall=4 BoxesUp("200,200,800,800", @normal) BoxDrawText(1, "390,50,990,990", "Bitmap Font Editor 0.4 %@crlf%Pick a Button ", @TRUE, 2) BoxTextFont(1, "Verdana", 30, 0, 0) BoxButtonDraw(1, bOfont, "Load Font (1)", "550,850,750,920") BoxButtonDraw(1, bExit, "Exit (2)", "770,850,920,920") BoxButtonDraw(1, bPrev, "<< char", "550,740,670,810") BoxButtonDraw(1, bNext, ">> char", "690,740,810,810") BoxButtonDraw(1, bGoto, "Go", "840,740,920,810") BoxButtonDraw(1, bSaveChar, "Save Char", "550,590,720,660") BoxButtonDraw(1, bSaveFont, "Save Font", "760,590,920,660") BoxDataTag(1, "Apr") ;~~~~~~~~~~~~~~~ button clicks ~~~~~~~~~~~~~~ :start1 bWho=0 while bWho == 0 for x =1 to 2 if BoxButtonStat(1,x) then bWho=x next endwhile Switch bWho case 1 If fopen==1 Then binbuf=BinaryFree(binbuf) fopen=0 fn1=" " types="All Files|*.*|WIL Files|*.wbt;*.mnu|Text Files|*.txt|" fn1=AskFileName("Select Font File", fold, types, "*.*", 1) GoSub fopen GoSub drawbox char=65 GoSub dispchar GoSub printchar GoSub printinfo GoSub mouse case 2 Break endswitch goto finito ;just while testing... ;########## open file ######## :fopen fopen=1 fs=FileSize(fn1) ;; Allocate a buffer the size of your file binbuf = BinaryAlloc(fs) if binbuf == 0 Message("Error", "BinaryAlloc Failed") goto finito else ;Read the font file into the buffer. BinaryRead(binbuf, fn1) endif return :askchar BoxDataClear(1,"Apr") GoSub drawbox ;now ask for character... char = AskLine("Goto character", "Please enter the ANSI character coder (0 to 255)", "") return :dispchar ; ;now ask for character... ; char = AskLine("see character", "Please enter the ANSI character coder (0 to 255)", "") lchar = char * 14 ;to know where begins the char in 8x14 font file... a1=BinaryPeek( binbuf, lchar ) ;Finds the value of a byte. a2=BinaryPeek( binbuf, lchar + 1 ) a3=BinaryPeek( binbuf, lchar + 2 ) a4=BinaryPeek( binbuf, lchar + 3 ) a5=BinaryPeek( binbuf, lchar + 4 ) a6=BinaryPeek( binbuf, lchar + 5 ) a7=BinaryPeek( binbuf, lchar + 6 ) a8=BinaryPeek( binbuf, lchar + 7 ) a9=BinaryPeek( binbuf, lchar + 8 ) a10=BinaryPeek( binbuf, lchar + 9 ) a11=BinaryPeek( binbuf, lchar + 10 ) a12=BinaryPeek( binbuf, lchar + 11 ) a13=BinaryPeek( binbuf, lchar + 12 ) a14=BinaryPeek( binbuf, lchar + 13 ) ; a15=BinaryPeek( binbuf, lchar + 14 ) ; a16=BinaryPeek( binbuf, lchar + 15 ) lines = "%a1%,%a2%,%a3%,%a4%,%a5%,%a6%,%a7%,%a8%,%a9%,%a10%,%a11%,%a12%,%a13%,%a14%" ;Display(1,"The current character:", "%lines%" ) ;Append a line to the end of the file in buffer. ; BinaryPokeStr(binbuf, fs, "DEVICE=C:\FLOOGLE.SYS%@crlf%") ; ; Write modified file back to the file from the buffer. ; BinaryWrite(binbuf, "C:\CONFIG.SYS") return ;################ printchar ######################## :printchar ;first erase info text oldy=1 ddx=1 ddy=1 GoSub parse GoSub showfile ln1=curline ddy=2 GoSub parse GoSub showfile ln2=curline ddy=3 GoSub parse GoSub showfile ln3=curline ddy=4 GoSub parse GoSub showfile ln4=curline ddy=5 GoSub parse GoSub showfile ln5=curline ddy=6 GoSub parse GoSub showfile ln6=curline ddy=7 GoSub parse GoSub showfile ln7=curline ddy=8 GoSub parse GoSub showfile ln8=curline ddy=9 GoSub parse GoSub showfile ln9=curline ddy=10 GoSub parse GoSub showfile ln10=curline ddy=11 GoSub parse GoSub showfile ln11=curline ddy=12 GoSub parse GoSub showfile ln12=curline ddy=13 GoSub parse GoSub showfile ln13=curline ddy=14 GoSub parse GoSub showfile ln14=curline ;goto start1 return ;########################## printinfo ########################### :printinfo cansi=Num2Char(char) BoxColor(1,"255,255,255",0) BoxDrawText(1, "390,150,990,990", "Character shown: %char% (ANSI: cansi)", @TRUE, 2) BoxDrawText(1, "390,250,990,990", "[%lines%]", @TRUE, 2) BoxDrawText(1, "390,350,990,990", "finished.", @TRUE, 2) return ;############################# showfile (x and y...) ######## :showfile GoSub fillbox ddx=2 GoSub fillbox ddx=3 GoSub fillbox ddx=4 GoSub fillbox ddx=5 GoSub fillbox ddx=6 GoSub fillbox ddx=7 GoSub fillbox ddx=8 GoSub fillbox ddx=1 return ;################################## drawbox ########################################### :drawbox ddx=9 ddy=3 GoSub guidelines ddy=6 GoSub guidelines ddy=11 GoSub guidelines ddx=1 ddy=1 boxdrawn=1 BoxDataClear(1,"Apr") BoxColor(1,"255,0,0",0) BoxDrawRect(1, "60,80,380,920", 0) BoxDrawLine(1,"100,80,100,920") BoxDrawLine(1,"140,80,140,920") BoxDrawLine(1,"180,80,180,920") BoxDrawLine(1,"220,80,220,920") BoxDrawLine(1,"260,80,260,920") BoxDrawLine(1,"300,80,300,920") BoxDrawLine(1,"340,80,340,920") BoxDrawLine(1,"60,140,380,140") BoxDrawLine(1,"60,200,380,200") BoxDrawLine(1,"60,260,380,260") BoxDrawLine(1,"60,320,380,320") BoxDrawLine(1,"60,380,380,380") BoxDrawLine(1,"60,440,380,440") BoxDrawLine(1,"60,500,380,500") BoxDrawLine(1,"60,560,380,560") BoxDrawLine(1,"60,620,380,620") BoxDrawLine(1,"60,680,380,680") BoxDrawLine(1,"60,740,380,740") BoxDrawLine(1,"60,800,380,800") BoxDrawLine(1,"60,860,380,860") return ;#################################### mouse ############################### :mouse while 1 cl=MouseInfo(4) If cl==4 ;if left mouse button clicked a=MouseInfo(6) a=strreplace(a," ",",") sep=StrScan(a, ",", 1, @FWDSCAN) ddx=StrSub(a, 1, sep-1) ddy=StrSub(a, sep+1, StrLen(a)-(sep)) If ddx < 60 Then break If ddy < 80 Then break ddx=(ddx-60)/40+1 ddy=(ddy-80)/60+1 If ddx < 9 && ddy < 15 && ddx > 0 && ddy > 0 GoSub parse GoSub edit GoSub printinfo Endif Endif If BoxButtonStat(1,2) Then goto finito If BoxButtonStat(1,3) Then GoSub PrevChar If BoxButtonStat(1,4) Then GoSub NextChar If BoxButtonStat(1,5) GoSub askchar GoSub dispchar GoSub printchar GoSub printinfo endif If BoxButtonStat(1,6) Then GoSub SaveChar If BoxButtonStat(1,7) Then GoSub SaveFont If BoxButtonStat(1,1) If fopen==1 Then binbuf=BinaryFree(binbuf) fopen=0 fn1=" " types="All Files|*.*|WIL Files|*.wbt;*.mnu|Text Files|*.txt|" fn1=AskFileName("Select Font File", fold, types, "*.*", 1) GoSub fopen GoSub drawbox char=65 GoSub dispchar GoSub printchar GoSub printinfo GoSub mouse Endif endwhile return ;############################# prevchar ############################ :PrevChar char=char-1 if char<1 then char=1 BoxDataClear(1,"Apr") GoSub drawbox GoSub dispchar GoSub printchar GoSub printinfo ;display(1,"hahaha :)","PREV CHAR not ready yet...") return ;############################# next char ########################## :NextChar char=char+1 if char>255 then char=255 BoxDataClear(1,"Apr") GoSub drawbox GoSub dispchar GoSub printchar GoSub printinfo ;display(1,"hahaha :)","NEXT CHAR not ready yet...") return ;####################### parse ######################## :parse q1=0 ;num2char(0) q2=0 q3=0 q4=0 q5=0 q6=0 q7=0 q8=0 curvl=num2char(0) ;check if already filled... if yes, color will be 1! and type (frame) 1 too! ;lines has all the values... in , delimited list... first, extract ddy-th value curvl = ItemExtract(ddy, lines, ",") testvl = ItemExtract(ddy, lines, ",") ;now parsing line bit values If curvl>=128 q1=1 curvl=curvl-128 Endif If curvl>=64 q2=1 curvl=curvl-64 Endif If curvl>=32 q3=1 curvl=curvl-32 Endif If curvl>=16 q4=1 curvl=curvl-16 Endif If curvl>=8 q5=1 curvl=curvl-8 Endif If curvl>=4 q6=1 curvl=curvl-4 Endif If curvl>=2 q7=1 curvl=curvl-2 Endif If curvl>=1 q8=1 Endif curline = "%q1%,%q2%,%q3%,%q4%,%q5%,%q6%,%q7%,%q8%" ;display(1,"Curent line is:","Line: %ddy%, line dec value: %testvl%, value: %curline%") return ;###################################### fillbox ############################ :fillbox ;Message("position...", "x pos: %ddx% and y pos: %ddy%") boxx=(ddx-1)*40+60+2 boxy=(ddy-1)*60+80+3 boxx2=(ddx-1)*40+60+40 boxy2=(ddy-1)*60+80+60 ;boxx=(ddx+60)+((ddx-1)*40) ;boxy=(ddy+80)+((ddy-1)*60) ;boxx2=boxx+35 ;boxy2=boxy+55 ;Display(1,"Curent line (%ddy%) has the folowing bits:","%curline%") xval = ItemExtract(ddx, curline, ",") RectType=2 BoxDataClear(1,"Apr") RectColor="255,0,0" If xval == 1 Then RectColor="255,0,0" If xval == 0 Then RectColor="255,255,255" BoxColor(1,RectColor,0) If xval==1 Then BoxDrawRect(1, "%boxx%,%boxy%,%boxx2%,%boxy2%", RectType) return ;###################################### edit (with mouse) ############################ :edit ;Message("position...", "x pos: %ddx% and y pos: %ddy%") boxx=(ddx-1)*40+60+2 boxy=(ddy-1)*60+80+3 boxx2=(ddx-1)*40+60+40 boxy2=(ddy-1)*60+80+60 ;boxx=(ddx+60)+((ddx-1)*40) ;boxy=(ddy+80)+((ddy-1)*60) ;boxx2=boxx+35 ;boxy2=boxy+55 ;Display(1,"Curent line (%ddy%) has the folowing bits:","%curline%") xval = ItemExtract(ddx, curline, ",") ;display(1,"xvalue:","%xval%") RectType=2 BoxDataClear(1,"Apr") RectColor="255,0,0" If xval == "1" ;display(1,"hahaha","valie is 1!") RectColor="255,255,255" xval=Num2Char(0) Endif If xval == 0 RectColor="255,0,0" xval=1 Endif curline = ItemRemove(ddx, curline, ",") curline = ItemInsert(xval, ddx-1, curline, ",") ;display(2,"xval ADDED:","%xval%") GoSub changevalue BoxColor(1,RectColor,0) BoxDrawRect(1, "%boxx%,%boxy%,%boxx2%,%boxy2%", RectType) return ;################# change value ########################### :changevalue curvl = ItemExtract(ddy, lines, ",") lines = ItemRemove(ddy, lines, ",") curvl=0 If ItemExtract(8, curline, ",") == 1 Then curvl=curvl+1 If ItemExtract(7, curline, ",") == 1 Then curvl=curvl+2 If ItemExtract(6, curline, ",") == 1 Then curvl=curvl+4 If ItemExtract(5, curline, ",") == 1 Then curvl=curvl+8 If ItemExtract(4, curline, ",") == 1 Then curvl=curvl+16 If ItemExtract(3, curline, ",") == 1 Then curvl=curvl+32 If ItemExtract(2, curline, ",") == 1 Then curvl=curvl+64 If ItemExtract(1, curline, ",") == 1 Then curvl=curvl+128 ;display(1,"new curvalue:","%curvl%") lines = ItemInsert(curvl, ddy-1, lines, ",") return ;################################# savechar ###################### :SaveChar ; char = AskLine("see character", "Please enter the ANSI character coder (0 to 255)", "") ; lchar = char * 14 ;to know where begins the char in 8x14 font file... a1=0 a2=0 a3=0 a4=0 a5=0 a6=0 a7=0 a8=0 a9=0 a10=0 a11=0 a12=0 a13=0 a14=0 a1=ItemExtract(1, lines, ",") a2=ItemExtract(2, lines, ",") a3=ItemExtract(3, lines, ",") a4=ItemExtract(4, lines, ",") a5=ItemExtract(5, lines, ",") a6=ItemExtract(6, lines, ",") a7=ItemExtract(7, lines, ",") a8=ItemExtract(8, lines, ",") a9=ItemExtract(9, lines, ",") a10=ItemExtract(10, lines, ",") a11=ItemExtract(11, lines, ",") a12=ItemExtract(12, lines, ",") a13=ItemExtract(13, lines, ",") a14=ItemExtract(14, lines, ",") ; a15=BinaryPeek( binbuf, lchar + 14 ) ; a16=BinaryPeek( binbuf, lchar + 15 ) savechar="%a1%%a2%%a3%%a4%%a5%%a6%%a7%%a8%%a9%%a10%%a11%%a12%%a13%%a14%" BinaryPoke(binbuf, char*14, a1) BinaryPoke(binbuf, char*14+1, a2) BinaryPoke(binbuf, char*14+2, a3) BinaryPoke(binbuf, char*14+3, a4) BinaryPoke(binbuf, char*14+4, a5) BinaryPoke(binbuf, char*14+5, a6) BinaryPoke(binbuf, char*14+6, a7) BinaryPoke(binbuf, char*14+7, a8) BinaryPoke(binbuf, char*14+8, a9) BinaryPoke(binbuf, char*14+9, a10) BinaryPoke(binbuf, char*14+10, a11) BinaryPoke(binbuf, char*14+11, a12) BinaryPoke(binbuf, char*14+12, a13) BinaryPoke(binbuf, char*14+13, a14) Display(1,"Good","The character has been saved.") return ;################################## savefont ###################### :SaveFont MyDialogFormat=`WWWDLGED,5.0` MyDialogCaption=`WIL Dialog` MyDialogX=126 MyDialogY=62 MyDialogWidth=169 MyDialogHeight=90 MyDialogNumControls=6 MyDialog01=`94,70,49,DEFAULT,PUSHBUTTON,DEFAULT,"&Save",2` MyDialog02=`25,70,49,DEFAULT,PUSHBUTTON,DEFAULT,"&Cancel",1` MyDialog03=`14,4,145,DEFAULT,STATICTEXT,DEFAULT,"Are you absolutely sure that you want to save the edited font?"` MyDialog04=`14,17,145,DEFAULT,STATICTEXT,DEFAULT,"(the older version will be replaced with the new edited one!)"` MyDialog05=`43,49,80,DEFAULT,CHECKBOX,saveall,"Save ¤t character too",4` MyDialog06=`25,35,118,DEFAULT,CHECKBOX,backup,"Back up the original file (adds .bak extension)",9` ButtonPushed=Dialog("MyDialog") If ButtonPushed==2 If saveall==4 Then GoSub SaveChar If backup==9 FileCopy(fn1,"*.bak",@FALSE) Endif BinaryWrite(binbuf, fn1) Display(1,"SAVED!","The file has been saved.") Endif ;If ButtonPushed==1 Then display(1,"CANCELLED!",":)") ; ; Write modified file back to the file from the buffer. ; BinaryWrite(binbuf, "C:\CONFIG.SYS") return ;###################################### guidelines ############################ :guidelines ;Message("position...", "x pos: %ddx% and y pos: %ddy%") boxx=(ddx-1)*40+60+2 boxy=(ddy-1)*60+80+3 boxx2=(ddx-1)*40+60+40 boxy2=(ddy-1)*60+80+60 ;boxx=(ddx+60)+((ddx-1)*40) ;boxy=(ddy+80)+((ddy-1)*60) ;boxx2=boxx+35 ;boxy2=boxy+55 RectType=2 BoxDataClear(1,"Apr") RectColor="0,255,0" BoxColor(1,RectColor,0) BoxDrawRect(1, "%boxx%,%boxy%,%boxx2%,%boxy2%", RectType) return :finito If fopen==1 Then binbuf=BinaryFree(binbuf)
Make your own free website on Tripod.com