pixel font editor

zylum · **Posted:** Sat Feb 28, 2004 1:47 am

i was bored an thougt it would be cool if i made a program that allows you to create your own pixel fonts and then use them. here's what i have so far

instructions: click on the grid to edit the letter. click outside the box to move on to the next letter... if you accidentaly click outside the box before you finish the current letter, tough lol... when naming, dont include any extension.

code:

setscreen ("graphics:145;160")
var coords : array 1 .. 26, 1 .. 5, 1 .. 5 of int
var file : int
var fileName : string

put "what is the"
put "font name?"
get fileName
fileName += ".font"
cls
open : file, fileName, put

procedure reset (L : int)
for x : 1 .. 5
for y : 1 .. 5
drawbox (x * 21 - 1, y * 21 - 1, x * 21 + 20, y * 21 + 20, black)
drawfillbox (x * 21, y * 21, x * 21 + 19, y * 21 + 19, grey)
coords (L, x, y) := 0
end for
end for
end reset

setscreen ("offscreenonly")

var letter : int := 65
var mx, my, md : int

for i : 1 .. 26
reset (letter - 64)
loop
locate (1, 1)
put "letter: ", chr (letter)
mousewhere (mx, my, md)
if md = 1 then
mx := mx div 21
my := my div 21
if mx >= 1 and my >= 1 and mx <= 5 and my <= 5 then
if coords (letter - 64, mx, my) = 0 then
coords (letter - 64, mx, my) := 1
drawfillbox (mx * 21, my * 21, mx * 21 + 19, my * 21 + 19, black)
else
coords (letter - 64, mx, my) := 0
drawfillbox (mx * 21, my * 21, mx * 21 + 19, my * 21 + 19, grey)
end if
View.Update
delay (200)
else
exit
end if
end if
View.Update
end loop
delay (500)
for x : 1 .. 5
for y : 1 .. 5
put : file, coords (letter - 64, x, y)
end for
end for
letter += 1
end for

cls

put "finished creating ", fileName

instructions: type in the name of the font (no extension required) then hit caps lock and type away.... so far it only recognizes capital letters, backspaces and enter... i also need to add a cursor so you know where youre at but ill do that later:

code:

setscreen ("nocursor")

var file : int
var fileName : string
put "what font?"
get fileName
fileName += ".font"

open : file, fileName, get

var font : array 1 .. 26, 1 .. 5, 1 .. 5 of int

for i : 1 .. 26
for x : 1 .. 5
for y : 1 .. 5
get : file, font (i, x, y)
end for
end for
end for

cls
var col : int := 0
var row : int := 2
var letter : string (1)
var L : array char of boolean

loop
getch (letter)
col += 1
if ord (letter) >= 65 and ord (letter) <= 91 then
for x : 1 .. 5
for y : 1 .. 5
drawdot (x + col * 6, y + (maxy - row * 6), font (ord (letter) - 64, x, y))
end for
end for
else
Input.KeyDown (L)
if L (KEY_BACKSPACE) then
col -= 1
for x : 1 .. 5
for y : 1 .. 5
drawdot (x + col * 6, y + (maxy - row * 6), 0)
end for
end for
col -= 1
elsif L (KEY_ENTER) then
row += 1
col := 0
end if
end if
end loop

-zylum

Cervantes · **Posted:** Sat Feb 28, 2004 11:42 am

looks really good. It's kinda hard to make a nice looking letter though because those squares are so hugely big, but either way, great job!

Paul · **Posted:** Sat Feb 28, 2004 12:39 pm

Its great

yes, you should make the grid boxes smaller or something, more than 5 by 5.

Thuged_Out_G · **Posted:** Sun Feb 29, 2004 3:59 pm

they are large when your creating the letters, and the letters look rather crappy lol...but once the font is finished, and you use it...the letters look quite good...awesome program

+20 BITS

Maverick · **Posted:** Sun Feb 29, 2004 4:06 pm

Wow really sweet program good job.

	Computer Science Canada Programming C, C++, Java, PHP, Ruby, Turing, VB Username: Password: Register
Wiki Blog Search Turing Chat Room Members