Some small tutorials for newbies!

[arpgme]

[syntax="qbasic"]


DEFINT A-Z
SUB fontedit (font(), gamedir$)

STATIC default$

DIM f(255), copybuf(4), menu$(3)

menu$(0) = "Previous Menu"
menu$(1) = "Edit Font..."
menu$(2) = "Import Font..."
menu$(3) = "Export Font..."

last = -1
FOR i = 32 TO 255
last = last + 1
f(last) = i
NEXT i

mode = -1

menuptr = 0
top = 0

ptr = -1 * linesize
linesize = 14

setkeys
DO
setwait timing(), 100
setkeys
tog = tog XOR 1
SELECT CASE mode
CASE -1
IF keyval(1) > 1 THEN EXIT DO
dummy = usemenu(menuptr, 0, 0, 3, 22)
IF keyval(57) > 1 OR keyval(28) > 1 THEN
IF menuptr = 0 THEN EXIT DO
IF menuptr = 1 THEN mode = 0
IF menuptr = 2 THEN GOSUB importfont
IF menuptr = 3 THEN GOSUB exportfont
END IF
CASE 0
IF keyval(1) > 1 THEN mode = -1
IF keyval(72) > 1 THEN ptr = large(ptr - linesize, -1 * linesize)
IF keyval(80) > 1 THEN ptr = small(ptr + linesize, last)
IF keyval(75) > 1 THEN ptr = large(ptr - 1, 0)
IF keyval(77) > 1 THEN ptr = small(ptr + 1, last)
IF keyval(57) > 1 OR keyval(28) > 1 THEN
IF ptr < 0 THEN
mode = -1
ELSE
mode = 1
x = 0: y = 0
END IF
END IF
IF keyval(29) > 0 AND keyval(19) > 1 THEN romfontchar font(), ptr
CASE 1
IF keyval(1) > 1 OR keyval(28) > 1 THEN mode = 0
IF keyval(72) > 1 THEN y = loopvar(y, 0, 7, -1)
IF keyval(80) > 1 THEN y = loopvar(y, 0, 7, 1)
IF keyval(75) > 1 THEN x = loopvar(x, 0, 7, -1)
IF keyval(77) > 1 THEN x = loopvar(x, 0, 7, 1)
IF keyval(57) > 1 THEN
setbit font(), 0, (f(ptr) * 8 + x) * 8 + y, (readbit(font(), 0, (f(ptr) *
END IF
END SELECT
IF mode >= 0 THEN
'--copy and paste support
IF (keyval(29) > 0 AND keyval(82) > 1) OR ((keyval(42) > 0 OR keyval(54) > 0
IF ((keyval(42) > 0 OR keyval(54) > 0) AND keyval(82) > 1) OR (keyval(29) >
END IF
IF mode = -1 THEN
standardmenu menu$(), 3, 22, menuptr, 0, 0, 0, dpage, 0
END IF

IF mode >= 0 THEN
xoff = 8: yoff = 8
FOR i = 0 TO last
textcolor 7, 8
IF ptr >= 0 THEN
IF mode = 0 THEN
IF (i MOD linesize) = (ptr MOD linesize) OR (i \ linesize) = (ptr \ lines
END IF
IF ptr = i THEN textcolor 14 + tog, 0
END IF
printstr CHR$(f(i)), xoff + (i MOD linesize) * 9, yoff + (i \ linesize) * 9
NEXT i
textcolor 7, 0
IF ptr < 0 THEN textcolor 14 + tog, 0
printstr menu$(0), 8, 0, dpage

IF ptr >= 0 THEN
xoff = 150
yoff = 4
rectangle xoff, yoff, 160, 160, 8, dpage
FOR i = 0 TO 7
FOR j = 0 TO 7
z = readbit(font(), 0, (f(ptr) * 8 + i) * 8 + j)
IF z THEN rectangle xoff + i * 20, yoff + j * 20, 20, 20, 7, dpage
NEXT j
NEXT i
IF mode = 1 THEN rectangle xoff + x * 20, yoff + y * 20, 20, 20, 2 + 8 * re
textcolor 15, 0
printstr "ASCII" + STR$(f(ptr)), 20, 190, dpage
IF f(ptr) < 32 THEN
printstr "RESERVED", 120, 190, dpage
ELSE
FOR i = 2 TO 53 _
IF f(ptr) = keyv(i, 2) THEN printstr "ALT+" + UCASE$(CHR$(keyv(i, 0))), 1_
IF f(ptr) = keyv(i, 3) THEN printstr "ALT+SHIFT+" + UCASE$(CHR$(keyv(i, 0_
NEXT i _
IF f(ptr) = 32 THEN printstr "SPACE", 120, 190, dpage _
END IF
END IF _
END IF _
_
SWAP vpage, dpage _
setvispage vpage _
clearpage dpage _
dowait _
LOOP _
GOSUB savefont 
EXIT SUB

loadfont:
DEF SEG = VARSEG(font(0)): BLOAD game$ + ".fnt", VARPTR(font(0))
setfont font()
RETURN

savefont:
DEF SEG = VARSEG(font(0)): BSAVE game$ + ".fnt", VARPTR(font(0)), 2048
RETURN

copychar:
FOR i = 0 TO 63
setbit copybuf(), 0, i, readbit(font(), 0, f(ptr) * 64 + i)
NEXT i
RETURN

pastechar:
FOR i = 0 TO 63
setbit font(), 0, f(ptr) * 64 + i, readbit(copybuf(), 0, i)
NEXT i
RETURN

importfont:
newfont$ = browse$(0, default$, "*.ohf", "")
IF newfont$ <> "" THEN
copyfile newfont$ + CHR$(0), game$ + ".fnt" + CHR$(0), buffer()

'--never overwrite 0 thru 31
FOR i = 0 TO 2047
setbit buffer(), 0, i, readbit(font(), 0, i)
NEXT i

GOSUB loadfont

FOR i = 0 TO 2047
setbit font(), 0, i, readbit(buffer(), 0, i)
NEXT i
menuptr = 1
mode = 0
END IF
RETURN

exportfont:
setkeys
newfont$ = "newfont"
DO
setwait timing(), 100
setkeys
tog = tog XOR 1
IF keyval(1) > 1 THEN EXIT DO

old$ = newfont$
strgrabber newfont$, 8
IF old$ <> newfont$ THEN
'--make sure only legal DOS filename chars are used
lastchar = ASC(UCASE$(RIGHT$("_" + newfont$, 1)))
SELECT CASE lastchar
CASE 48 TO 57, 65 TO 90, 95, 126
'--legal chars
CASE 32
'--replace space with underscore
newfont$ = old$ + "_"
CASE ELSE
'--illegal chars
newfont$ = old$
END SELECT
END IF

IF keyval(28) > 1 THEN
GOSUB savefont
copyfile game$ + ".fnt" + CHR$(0), gamedir$ + "\" + newfont$ + ".ohf" + CHR$(0), buffer()


textcolor 7, 0
printstr "Input a filename to save to", 0, 0, dpage
printstr "[" + gamedir$ + "\" + newfont$ + ".ohf]", 0, 8, dpage
textcolor 14 + tog, 1
printstr newfont$, 0, 16, dpage

SWAP vpage, dpage
setvispage vpage
clearpage dpage
dowait
LOOP
RETURN

END SUB[/syntax]

[Anonymous]

edit your post.

select all the text and hit the code button, enclosing it.

thats what its there for, nonmonospaced code sux, plus you have all the smilies. ugh

Code:

like this dude

[arpgme]

Thanx

[Dio]

using

[syntax="qbasic"]

[/syntax]


gives it a colorful effect

[arpgme]

[syntax="qbasic"]

'----------------------A thing for getting bord----------------------------------
CLS ' clear screen
SCREEN 13 ' set this screen 13
'color 6 is Donut!
'color 1 is blue berry donut!
'color 0 is nothing
SLEEP 3
PRINT "Flying Blue Berry Donut!"
PRINT "MMMM,MMMM!"
SLEEP 3
CLS
'----------------------------------
FOR x = 1 TO 10
FOR y = 1 TO 10

READ clr
IF clr = 6 THEN PSET (x, y), 6
IF clr = 1 THEN PSET (x, y), 1
IF clr = 0 THEN PSET (x, y), 0
NEXT: NEXT

DATA 0,6,6,6,6,6,6,6,6,0
DATA 6,6,1,1,0,1,1,6,6,6
DATA 6,6,1,1,0,1,1,6,6,6
DATA 6,6,1,1,0,1,1,6,6,6
DATA 6,6,1,1,0,1,1,6,6,6
DATA 6,6,1,1,0,1,1,6,6,6
DATA 6,6,1,1,0,1,1,6,6,6
DATA 6,6,1,1,0,1,1,6,6,6
DATA 0,6,1,1,0,1,1,6,6,6
DATA 0,0,6,6,6,6,6,6,6,0

' your done![/syntax]

[arpgme]

[syntax="qbasic"]

' Phone Book
PRINT " JPB version 1.0"
PRINT " for help type help"
1 INPUT "", help$
IF help$ = "help" THEN GOTO 2
IF help$ = "add" THEN GOTO 3
IF help$ = "view" THEN GOTO 4
2 PRINT " look up our number by typing a name or make your own by"
PRINT " Typing add, or view to see the phone numbers"
GOTO 1
3 OPEN "c:\jpb.txt" FOR OUTPUT AS #1
INPUT "name:", name$
INPUT "number:", number$
INPUT "address", address$
PRINT #1, name$
PRINT #1, number$
PRINT #1, address$
INPUT " anymore?", more$
IF more$ = "yes" THEN GOTO 3
¦IF more$ = "no" THEN CLOSE #1
¦GOTO 1
¦4 OPEN "c:\jpb.txt" FOR INPUT AS #1
¦PRINT name$
¦PRINT number$
¦PRINT address$
¦
¦PRINT "-----------------------------"
¦PRINT " Chinese Food (555) 555-5555/ (555) 555-5555"
¦PRINT " seen enough?", leeyania$
¦CLOSE #1
¦IF leeyania$ = "yes" THEN GOTO 1
¦IF leeyania$ = "no" THEN GOTO 4
¦[/syntax]