Credits

[b][red]This message was edited by Margalo at 2005-10-17 14:35:48[/red][/b][hr]
I'm back! not that any of you noticed/cared that I was gone anyway.

Anyway I have just completed a program (never mind what it is) and I want to put credits at the end of it. (no big deal) But for these credits I wanted to have just plan yellow print text scroll up the screen. When I tried to do this I ended up With a chopy thing of the text moving up one line at a time. What I want to make is a line that slowly and smoothly moves up the screen. I myself cannot figure out how to do this.

[hr]
[purple][italic] I remain gentlemen your obedient servant [/purple]
[b][red] -OG.[/italic][/b][/red]

[white]-Margalo ;-) [/white]



Comments

  • : [b][red]This message was edited by Margalo at 2005-10-17 14:35:48[/red][/b][hr]
    : I'm back! not that any of you noticed/cared that I was gone anyway.
    :
    : Anyway I have just completed a program (never mind what it is) and I want to put credits at the end of it. (no big deal) But for these credits I wanted to have just plan yellow print text scroll up the screen. When I tried to do this I ended up With a chopy thing of the text moving up one line at a time. What I want to make is a line that slowly and smoothly moves up the screen. I myself cannot figure out how to do this.
    :
    : [hr]
    : [purple][italic] I remain gentlemen your obedient servant [/purple]
    : [b][red] -OG.[/italic][/b][/red]
    :
    : [white]-Margalo ;-) [/white]
    :
    :
    :
    :
    [blue]try to add more empty lines between text lines -OR- if you have the ability those empty lines in between should use a smaller font. maybe same color as background. that will make it seem less choppy... other than that, you must go graphical[/blue]
  • : [b][red]This message was edited by Margalo at 2005-10-17 14:35:48[/red][/b][hr]
    : I'm back! not that any of you noticed/cared that I was gone anyway.
    :
    : Anyway I have just completed a program (never mind what it is) and I want to put credits at the end of it. (no big deal) But for these credits I wanted to have just plan yellow print text scroll up the screen. When I tried to do this I ended up With a chopy thing of the text moving up one line at a time. What I want to make is a line that slowly and smoothly moves up the screen. I myself cannot figure out how to do this.
    :
    : [hr]
    : [purple][italic] I remain gentlemen your obedient servant [/purple]
    : [b][red] -OG.[/italic][/b][/red]
    :
    : [white]-Margalo ;-) [/white]
    :
    :
    :
    :
    This is some code I wrote a year ago

    CREW3.BAS:
    [code]
    DEFINT A-Z
    DECLARE SUB skriv (text$, rad%, collumn%, farg%)
    DECLARE SUB loadchr (file$)
    DATA 8
    DATA Hej,jag,heter,Niklas,Ulvinge,och,r,bst,







    DIM SHARED chrS$(255)
    READ max
    DIM text$(max)
    DIM textro$(max)
    DIM textpo$(max)
    FOR a = 0 TO max
    READ text$(a)
    textro(a) = 480 + (a * 16)
    textpo(a) = 320 - LEN(text$(a)) * 4
    NEXT


    SCREEN 12
    loadchr "C:98 CBasicEDITORSNORMAL"
    DO
    FOR a = 0 TO max
    skriv text$(a), textro(a), textpo(a), 10
    textro(a) = textro(a) - 1
    NEXT
    IF textro(max) = -16 THEN END
    LOOP

    DEFSNG A-Z
    SUB loadchr (file$)
    OPEN file$ + ".chr" FOR INPUT AS #1
    FOR a = 0 TO 255
    B = ASC(INPUT$(1, #1)) - 128
    IF B > 0 THEN chrS$(a) = INPUT$(B, #1)
    NEXT
    CLOSE
    END SUB

    DEFINT A-Z
    SUB skriv (text$, rad, collumn, farg)
    SHARED qw
    IF qw = 4 THEN text$ = UCASE$(text$)

    FOR a = 0 TO LEN(text$) - 1
    B = ASC(MID$(text$, a + 1))
    IF B = 13 THEN rad = rad + 16
    IF B = 9 THEN collumn = collumn + 64
    IF B = 32 THEN collumn = collumn + 4

    FOR x = 0 TO (LEN(chrS$(B)) / 2) - 1
    x3 = x3 + 1
    c = ASC(MID$(chrS$(B), ((x * 2) + 1)))
    c2 = ASC(MID$(chrS$(B), ((x * 2) + 2)))
    x2 = x3 + collumn

    IF c > 127 THEN PSET (x2, rad), farg: c = c - 128 ELSE PSET (x2, rad), 0
    IF c > 63 THEN PSET (x2, rad + 1), farg: c = c - 64 ELSE PSET (x2, rad + 1), 0
    IF c > 31 THEN PSET (x2, rad + 2), farg: c = c - 32 ELSE PSET (x2, rad + 2), 0
    IF c > 15 THEN PSET (x2, rad + 3), farg: c = c - 16 ELSE PSET (x2, rad + 3), 0
    IF c > 7 THEN PSET (x2, rad + 4), farg: c = c - 8 ELSE PSET (x2, rad + 4), 0
    IF c > 3 THEN PSET (x2, rad + 5), farg: c = c - 4 ELSE PSET (x2, rad + 5), 0
    IF c > 1 THEN PSET (x2, rad + 6), farg: c = c - 2 ELSE PSET (x2, rad + 6), 0
    IF c > 0 THEN PSET (x2, rad + 7), farg: c = c - 1 ELSE PSET (x2, rad + 7), 0
    IF c2 > 127 THEN PSET (x2, rad + 8), farg: c2 = c2 - 128 ELSE PSET (x2, rad + 8), 0
    IF c2 > 63 THEN PSET (x2, rad + 9), farg: c2 = c2 - 64 ELSE PSET (x2, rad + 9), 0
    IF c2 > 31 THEN PSET (x2, rad + 10), farg: c2 = c2 - 32 ELSE PSET (x2, rad + 10), 0
    IF c2 > 15 THEN PSET (x2, rad + 11), farg: c2 = c2 - 16 ELSE PSET (x2, rad + 11), 0
    IF c2 > 7 THEN PSET (x2, rad + 12), farg: c2 = c2 - 8 ELSE PSET (x2, rad + 12), 0
    IF c2 > 3 THEN PSET (x2, rad + 13), farg: c2 = c2 - 4 ELSE PSET (x2, rad + 13), 0
    IF c2 > 1 THEN PSET (x2, rad + 14), farg: c2 = c2 - 2 ELSE PSET (x2, rad + 14), 0
    IF c2 > 0 THEN PSET (x2, rad + 15), farg: c2 = c2 - 1 ELSE PSET (x2, rad + 15), 0

    NEXT x
    x3 = x3 + 1
    NEXT a
    END SUB
    [/code]
    You'll need a file wich contains a font in a my format...

    Here's the editor I wrote for it.

    CHRS$E1.BAS:
    [code]
    ' Nice Print Font Editor
    ' Version 4.0
    '
    'Purpose:
    ' The purpose for this program was that I wanted to print in pixel level.
    ' But in version 3.5 of this program I programed so the text have been
    ' nice as a new text editor. And in version 4.0 I programed the editor.
    ' In the editor you can do your own font.
    '
    'Features:
    ' In version 2.0 I did save the files in a special way. I took each pixels
    ' on every line and treated it as bit's (o's and one's) and then transformed
    ' them to a byte (eight bit's). After that I took the byte and tranformed
    ' it to a character. This means that one letter only takes 16 characters
    ' in screen mode 12. I (or you) must change the code if you want to use
    ' this program in any other screen mode that do not have 8*16 pixels.
    '
    ' Then in version 2.5 I only do so the loading has been some faster but
    ' lesser numbers of character. you can change the number by changing the
    ' variabel qw.
    ' qw = 1 means full ascii code
    ' qw = 2 means half of ascii code
    ' qw = 3 means alfabet lower and upper
    ' qw = 4 means alfabet upper
    '
    ' After that in version 3.0 I change the saving from horisontal to vertical.
    '
    ' And then in version 3.2 I do not save the line that is complitly black.
    '
    ' The nices thing with this program hapend in version 3.5. I have take away
    ' the the line that is complitly black in the writing to. This do show a
    ' very nice text.'Till och med''lika'nice as a new text editor.
    '
    ' In version 3.7 I fixed a bug with the black line with space and character
    ' size.
    '
    ' I programed the editor in version 4.0. The qw fast loading has been taken
    ' away because the program dosn't load anymore. Ofcours it load but it
    ' takes lesser than one seacond. The thing that takes time is the printing
    ' on the screen.
    '
    ' In version 4.1 I fixed some bugs from the first editor.
    '
    '
    '
    '
    '
    'Programed by:
    ' Niklas Ulvigne
    ' 26th January 2003
    ' 05:00
    '
    'Mail my at: [email protected]
    '
    DECLARE SUB chrsave (a!)
    DECLARE SUB init ()
    DECLARE SUB loadchr (file$)
    DECLARE SUB skriv (text$, rad%, collumn%, farg%)
    DIM SHARED chrS$(255)
    DIM SHARED chr(7, 15)
    SCREEN 12
    init
    start:
    CLS

    B = 1
    c = 0
    FOR a = 0 TO 255
    B = B + 1
    IF B = 65 THEN c = c + 1: B = 0
    skriv CHR$(a), c * 18 + 1, B * 9, 7
    NEXT

    andr:
    LINE (400, 200)-(560, 360), 0, BF
    LINE (B * 9, c * 18)-(B * 9 + 9, c * 18 + 17), 0, B
    B = 0
    c = 0
    IF achr > 192 AND c = 0 THEN c = 3: B = achr - 193
    IF achr > 127 AND c = 0 THEN c = 2: B = achr - 128
    IF achr > 62 AND c = 0 THEN c = 1: B = achr - 63
    IF c = 0 THEN B = achr + 2
    LINE (B * 9, c * 18)-(B * 9 + 9, c * 18 + 17), 15, B

    PALETTE 1, 0
    skriv CHR$(achr), 0, -1, 1
    ERASE chr

    FOR x = 0 TO 7
    FOR y = 0 TO 15
    LINE (x * 20 + 400, y * 10 + 200)-(x * 20 + 419, y * 10 + 209), 7, B
    IF POINT(x, y) THEN chr(x, y) = 1: LINE (x * 20 + 407, y * 10 + 202)-(x * 20 + 413, y * 10 + 207), 7, BF
    NEXT y, x
    LOCATE 1, 1: PRINT " "
    x = 0: y = 0

    DO
    t = 0
    a$ = UCASE$(INKEY$)
    IF a$ = CHR$(27) THEN END
    IF a$ = CHR$(0) + CHR$(59) THEN GOTO info
    IF a$ = CHR$(0) + CHR$(60) THEN GOTO new
    IF a$ = CHR$(0) + CHR$(61) THEN GOTO save
    IF a$ = CHR$(0) + CHR$(62) THEN GOTO load
    IF a$ = CHR$(0) + CHR$(63) THEN GOTO dele
    IF a$ = CHR$(0) + CHR$(75) OR a$ = CHR$(0) + CHR$(77) OR a$ = CHR$(0) + CHR$(72) OR a$ = CHR$(0) + CHR$(80) THEN LINE (x * 20 + 401, y * 10 + 201)-(x * 20 + 418, y * 10 + 208), 0, B
    IF a$ = CHR$(0) + CHR$(75) THEN x = x - 1
    IF a$ = CHR$(0) + CHR$(77) THEN x = x + 1
    IF a$ = CHR$(0) + CHR$(72) THEN y = y - 1
    IF a$ = CHR$(0) + CHR$(80) THEN y = y + 1
    IF a$ = "C" THEN LOCATE 15, 5: INPUT "Byt till vilken ascii numer", a: achr = a: t = 3
    IF a$ = "S" OR a$ = "W" OR a$ = "D" OR a$ = "A" THEN chrsave achr: LINE (B * 9, c * 18)-(B * 9 + 9, c * 18 + 17), 0, BF: skriv CHR$(achr), c * 18 + 1, B * 9, 7: t = 2
    IF a$ = "S" THEN achr = achr + 65
    IF a$ = "W" THEN achr = achr - 65
    IF a$ = "D" THEN achr = achr + 1
    IF a$ = "A" THEN achr = achr - 1
    IF achr > 255 THEN achr = achr - 255 - 1
    IF achr < 0 THEN achr = 255 + achr + 1
    IF t = 2 THEN GOTO andr
    IF t = 3 THEN GOTO start

    IF x > 7 THEN x = 7
    IF x < 0 THEN x = 0
    IF y > 15 THEN y = 15
    IF y < 0 THEN y = 0
    IF a$ = " " AND chr(x, y) = 0 THEN t = 1: chr(x, y) = 1: LINE (x * 20 + 407, y * 10 + 202)-(x * 20 + 413, y * 10 + 207), 7, BF
    IF a$ = " " AND chr(x, y) = 1 AND t = 0 THEN chr(x, y) = 0: LINE (x * 20 + 407, y * 10 + 202)-(x * 20 + 413, y * 10 + 207), 0, BF

    LINE (x * 20 + 401, y * 10 + 201)-(x * 20 + 418, y * 10 + 208), 15, B
    LOOP

    info:
    CLS
    PRINT "F1: This help side"
    PRINT "F2: New font"
    PRINT "F3: Save font"
    PRINT "F4: Load font"
    PRINT "F5: Erase font"
    PRINT
    PRINT "Up arrow: move up in pixel mode"
    PRINT "Down arrow: move down in pixel mode"
    PRINT "Right arrow: move right in pixel mode"
    PRINT "Left arrow: move left in pixel mode"
    PRINT "Space: Activate or unactivate the actual pixel"
    PRINT
    PRINT "W: move up in character mode"
    PRINT "S: move down in character mode"
    PRINT "D: move right in character mode"
    PRINT "A: move left in character mode"
    PRINT "C: change character"

    DO: LOOP UNTIL INKEY$ = ""
    DO: LOOP UNTIL INKEY$ <> ""
    GOTO start

    new:
    ERASE chrS$
    GOTO start

    save:
    COLOR 7
    SHELL "DIR *.chr"
    PRINT "Save as:"
    INPUT a$
    IF a$ = "" THEN GOTO start
    OPEN a$ + ".chr" FOR OUTPUT AS #1
    CLOSE
    KILL a$ + ".chr"

    OPEN a$ + ".chr" FOR OUTPUT AS #1
    FOR a = 0 TO 255
    PRINT #1, CHR$(LEN(chrS$(a)) + 128); chrS$(a);
    NEXT
    CLOSE
    GOTO start

    load:
    COLOR 7
    SHELL "DIR *.chr"
    PRINT "Load file:"
    INPUT a$
    IF a$ = "" THEN GOTO start
    ERASE chrS$
    loadchr (a$)
    GOTO start

    dele:
    COLOR 7
    SHELL "DIR *.chr"
    PRINT "Erase file:"
    INPUT a$
    IF a$ = "" THEN GOTO start
    KILL a$ + ".chr"
    GOTO start

    SUB chrsave (a)
    DIM B(15)
    chrS$(a) = ""

    FOR x = 0 TO 7
    FOR y = 0 TO 15
    IF chr(x, y) = 1 THEN B(y) = 1 ELSE B(y) = 0
    NEXT y

    c = (B(0) * 128) + (B(1) * 64) + (B(2) * 32) + (B(3) * 16) + (B(4) * 8) + (B(5) * 4) + (B(6) * 2) + B(7)
    c2 = (B(8) * 128) + (B(9) * 64) + (B(10) * 32) + (B(11) * 16) + (B(12) * 8) + (B(13) * 4) + (B(14) * 2) + B(15)

    IF chrS$(a) = "" THEN
    IF c OR c2 THEN
    chrS$(a) = CHR$(c)
    chrS$(a) = chrS$(a) + CHR$(c2)
    END IF
    ELSE
    chrS$(a) = chrS$(a) + CHR$(c)
    chrS$(a) = chrS$(a) + CHR$(c2)
    END IF

    NEXT x
    FOR B = 0 TO LEN(chrS$(a)) - 1
    IF RIGHT$(chrS$(a), 2) = CHR$(0) + CHR$(0) THEN chrS$(a) = LEFT$(chrS$(a), LEN(chrS$(a)) - 2)
    NEXT B
    END SUB

    DEFINT A-Z
    SUB init
    DIM B(15)

    FOR a = 0 TO 255
    LOCATE 1, 1: COLOR 15: PRINT CHR$(0)
    LOCATE 1, 1: COLOR 15: PRINT CHR$(a)
    LOCATE 2, 1: COLOR 7
    PRINT STR$(a / (255 / 100)); "% "
    chrS$(a) = ""

    FOR x = 0 TO 7
    FOR y = 0 TO 15
    IF POINT(x, y) THEN B(y) = 1 ELSE B(y) = 0
    NEXT y

    c = (B(0) * 128) + (B(1) * 64) + (B(2) * 32) + (B(3) * 16) + (B(4) * 8) + (B(5) * 4) + (B(6) * 2) + B(7)
    c2 = (B(8) * 128) + (B(9) * 64) + (B(10) * 32) + (B(11) * 16) + (B(12) * 8) + (B(13) * 4) + (B(14) * 2) + B(15)

    IF chrS$(a) = "" THEN
    IF c OR c2 THEN
    chrS$(a) = chrS$(a) + CHR$(c)
    chrS$(a) = chrS$(a) + CHR$(c2)
    END IF
    ELSE
    chrS$(a) = chrS$(a) + CHR$(c)
    chrS$(a) = chrS$(a) + CHR$(c2)
    END IF

    NEXT x
    FOR B = 0 TO LEN(chrS$(a)) - 1
    IF RIGHT$(chrS$(a), 2) = CHR$(0) + CHR$(0) THEN chrS$(a) = LEFT$(chrS$(a), LEN(chrS$(a)) - 2)
    NEXT B
    NEXT a
    END SUB

    DEFSNG A-Z
    SUB loadchr (file$)
    OPEN file$ + ".chr" FOR INPUT AS #1
    FOR a = 0 TO 255
    B = ASC(INPUT$(1, #1)) - 128
    IF B > 0 THEN chrS$(a) = INPUT$(B, #1)
    NEXT
    CLOSE
    END SUB

    DEFINT A-Z
    SUB skriv (text$, rad, collumn, farg)
    SHARED qw
    IF qw = 4 THEN text$ = UCASE$(text$)

    FOR a = 0 TO LEN(text$) - 1
    B = ASC(MID$(text$, a + 1))
    IF B = 13 THEN rad = rad + 16
    IF B = 9 THEN collumn = collumn + 64
    IF B = 32 THEN collumn = collumn + 4

    FOR x = 0 TO (LEN(chrS$(B)) / 2) - 1
    x3 = x3 + 1
    c = ASC(MID$(chrS$(B), ((x * 2) + 1)))
    c2 = ASC(MID$(chrS$(B), ((x * 2) + 2)))
    x2 = x3 + collumn

    FOR p = 0 TO 7
    IF (c AND 2 ^ p) / 2 ^ p THEN PSET (x2, rad + 7 + -p), farg
    NEXT p
    FOR p = 0 TO 7
    IF (c2 AND 2 ^ p) / 2 ^ p THEN PSET (x2, rad + 15 + -p), farg
    NEXT p, x
    x3 = x3 + 1
    NEXT a
    END SUB

    [/code]
    The descriptioin in the begining was for me to remember what it did...

    I hope I will be in the credits...

    The one and only [b]Niklas Ulvinge[/b] [white]aka [b]IDK[/b][/white]

  • : : [b][red]This message was edited by Margalo at 2005-10-17 14:35:48[/red][/b][hr]
    : : I'm back! not that any of you noticed/cared that I was gone anyway.
    : :
    : : Anyway I have just completed a program (never mind what it is) and I want to put credits at the end of it. (no big deal) But for these credits I wanted to have just plan yellow print text scroll up the screen. When I tried to do this I ended up With a chopy thing of the text moving up one line at a time. What I want to make is a line that slowly and smoothly moves up the screen. I myself cannot figure out how to do this.
    : :
    : : [hr]
    : : [purple][italic] I remain gentlemen your obedient servant [/purple]
    : : [b][red] -OG.[/italic][/b][/red]
    : :
    : : [white]-Margalo ;-) [/white]
    : :
    : :
    : :
    : :
    : This is some code I wrote a year ago
    :
    : CREW3.BAS:
    : [code]
    : DEFINT A-Z
    : DECLARE SUB skriv (text$, rad%, collumn%, farg%)
    : DECLARE SUB loadchr (file$)
    : DATA 8
    : DATA Hej,jag,heter,Niklas,Ulvinge,och,r,bst,
    :
    :
    :
    :
    :
    :
    :
    : DIM SHARED chrS$(255)
    : READ max
    : DIM text$(max)
    : DIM textro$(max)
    : DIM textpo$(max)
    : FOR a = 0 TO max
    : READ text$(a)
    : textro(a) = 480 + (a * 16)
    : textpo(a) = 320 - LEN(text$(a)) * 4
    : NEXT
    :
    :
    : SCREEN 12
    : loadchr "C:98 CBasicEDITORSNORMAL"
    : DO
    : FOR a = 0 TO max
    : skriv text$(a), textro(a), textpo(a), 10
    : textro(a) = textro(a) - 1
    : NEXT
    : IF textro(max) = -16 THEN END
    : LOOP
    :
    : DEFSNG A-Z
    : SUB loadchr (file$)
    : OPEN file$ + ".chr" FOR INPUT AS #1
    : FOR a = 0 TO 255
    : B = ASC(INPUT$(1, #1)) - 128
    : IF B > 0 THEN chrS$(a) = INPUT$(B, #1)
    : NEXT
    : CLOSE
    : END SUB
    :
    : DEFINT A-Z
    : SUB skriv (text$, rad, collumn, farg)
    : SHARED qw
    : IF qw = 4 THEN text$ = UCASE$(text$)
    :
    : FOR a = 0 TO LEN(text$) - 1
    : B = ASC(MID$(text$, a + 1))
    : IF B = 13 THEN rad = rad + 16
    : IF B = 9 THEN collumn = collumn + 64
    : IF B = 32 THEN collumn = collumn + 4
    :
    : FOR x = 0 TO (LEN(chrS$(B)) / 2) - 1
    : x3 = x3 + 1
    : c = ASC(MID$(chrS$(B), ((x * 2) + 1)))
    : c2 = ASC(MID$(chrS$(B), ((x * 2) + 2)))
    : x2 = x3 + collumn
    :
    : IF c > 127 THEN PSET (x2, rad), farg: c = c - 128 ELSE PSET (x2, rad), 0
    : IF c > 63 THEN PSET (x2, rad + 1), farg: c = c - 64 ELSE PSET (x2, rad + 1), 0
    : IF c > 31 THEN PSET (x2, rad + 2), farg: c = c - 32 ELSE PSET (x2, rad + 2), 0
    : IF c > 15 THEN PSET (x2, rad + 3), farg: c = c - 16 ELSE PSET (x2, rad + 3), 0
    : IF c > 7 THEN PSET (x2, rad + 4), farg: c = c - 8 ELSE PSET (x2, rad + 4), 0
    : IF c > 3 THEN PSET (x2, rad + 5), farg: c = c - 4 ELSE PSET (x2, rad + 5), 0
    : IF c > 1 THEN PSET (x2, rad + 6), farg: c = c - 2 ELSE PSET (x2, rad + 6), 0
    : IF c > 0 THEN PSET (x2, rad + 7), farg: c = c - 1 ELSE PSET (x2, rad + 7), 0
    : IF c2 > 127 THEN PSET (x2, rad + 8), farg: c2 = c2 - 128 ELSE PSET (x2, rad + 8), 0
    : IF c2 > 63 THEN PSET (x2, rad + 9), farg: c2 = c2 - 64 ELSE PSET (x2, rad + 9), 0
    : IF c2 > 31 THEN PSET (x2, rad + 10), farg: c2 = c2 - 32 ELSE PSET (x2, rad + 10), 0
    : IF c2 > 15 THEN PSET (x2, rad + 11), farg: c2 = c2 - 16 ELSE PSET (x2, rad + 11), 0
    : IF c2 > 7 THEN PSET (x2, rad + 12), farg: c2 = c2 - 8 ELSE PSET (x2, rad + 12), 0
    : IF c2 > 3 THEN PSET (x2, rad + 13), farg: c2 = c2 - 4 ELSE PSET (x2, rad + 13), 0
    : IF c2 > 1 THEN PSET (x2, rad + 14), farg: c2 = c2 - 2 ELSE PSET (x2, rad + 14), 0
    : IF c2 > 0 THEN PSET (x2, rad + 15), farg: c2 = c2 - 1 ELSE PSET (x2, rad + 15), 0
    :
    : NEXT x
    : x3 = x3 + 1
    : NEXT a
    : END SUB
    : [/code]
    : You'll need a file wich contains a font in a my format...
    :
    : Here's the editor I wrote for it.
    :
    : CHRS$E1.BAS:
    : [code]
    : ' Nice Print Font Editor
    : ' Version 4.0
    : '
    : 'Purpose:
    : ' The purpose for this program was that I wanted to print in pixel level.
    : ' But in version 3.5 of this program I programed so the text have been
    : ' nice as a new text editor. And in version 4.0 I programed the editor.
    : ' In the editor you can do your own font.
    : '
    : 'Features:
    : ' In version 2.0 I did save the files in a special way. I took each pixels
    : ' on every line and treated it as bit's (o's and one's) and then transformed
    : ' them to a byte (eight bit's). After that I took the byte and tranformed
    : ' it to a character. This means that one letter only takes 16 characters
    : ' in screen mode 12. I (or you) must change the code if you want to use
    : ' this program in any other screen mode that do not have 8*16 pixels.
    : '
    : ' Then in version 2.5 I only do so the loading has been some faster but
    : ' lesser numbers of character. you can change the number by changing the
    : ' variabel qw.
    : ' qw = 1 means full ascii code
    : ' qw = 2 means half of ascii code
    : ' qw = 3 means alfabet lower and upper
    : ' qw = 4 means alfabet upper
    : '
    : ' After that in version 3.0 I change the saving from horisontal to vertical.
    : '
    : ' And then in version 3.2 I do not save the line that is complitly black.
    : '
    : ' The nices thing with this program hapend in version 3.5. I have take away
    : ' the the line that is complitly black in the writing to. This do show a
    : ' very nice text.'Till och med''lika'nice as a new text editor.
    : '
    : ' In version 3.7 I fixed a bug with the black line with space and character
    : ' size.
    : '
    : ' I programed the editor in version 4.0. The qw fast loading has been taken
    : ' away because the program dosn't load anymore. Ofcours it load but it
    : ' takes lesser than one seacond. The thing that takes time is the printing
    : ' on the screen.
    : '
    : ' In version 4.1 I fixed some bugs from the first editor.
    : '
    : '
    : '
    : '
    : '
    : 'Programed by:
    : ' Niklas Ulvigne
    : ' 26th January 2003
    : ' 05:00
    : '
    : 'Mail my at: [email protected]
    : '
    : DECLARE SUB chrsave (a!)
    : DECLARE SUB init ()
    : DECLARE SUB loadchr (file$)
    : DECLARE SUB skriv (text$, rad%, collumn%, farg%)
    : DIM SHARED chrS$(255)
    : DIM SHARED chr(7, 15)
    : SCREEN 12
    : init
    : start:
    : CLS
    :
    : B = 1
    : c = 0
    : FOR a = 0 TO 255
    : B = B + 1
    : IF B = 65 THEN c = c + 1: B = 0
    : skriv CHR$(a), c * 18 + 1, B * 9, 7
    : NEXT
    :
    : andr:
    : LINE (400, 200)-(560, 360), 0, BF
    : LINE (B * 9, c * 18)-(B * 9 + 9, c * 18 + 17), 0, B
    : B = 0
    : c = 0
    : IF achr > 192 AND c = 0 THEN c = 3: B = achr - 193
    : IF achr > 127 AND c = 0 THEN c = 2: B = achr - 128
    : IF achr > 62 AND c = 0 THEN c = 1: B = achr - 63
    : IF c = 0 THEN B = achr + 2
    : LINE (B * 9, c * 18)-(B * 9 + 9, c * 18 + 17), 15, B
    :
    : PALETTE 1, 0
    : skriv CHR$(achr), 0, -1, 1
    : ERASE chr
    :
    : FOR x = 0 TO 7
    : FOR y = 0 TO 15
    : LINE (x * 20 + 400, y * 10 + 200)-(x * 20 + 419, y * 10 + 209), 7, B
    : IF POINT(x, y) THEN chr(x, y) = 1: LINE (x * 20 + 407, y * 10 + 202)-(x * 20 + 413, y * 10 + 207), 7, BF
    : NEXT y, x
    : LOCATE 1, 1: PRINT " "
    : x = 0: y = 0
    :
    : DO
    : t = 0
    : a$ = UCASE$(INKEY$)
    : IF a$ = CHR$(27) THEN END
    : IF a$ = CHR$(0) + CHR$(59) THEN GOTO info
    : IF a$ = CHR$(0) + CHR$(60) THEN GOTO new
    : IF a$ = CHR$(0) + CHR$(61) THEN GOTO save
    : IF a$ = CHR$(0) + CHR$(62) THEN GOTO load
    : IF a$ = CHR$(0) + CHR$(63) THEN GOTO dele
    : IF a$ = CHR$(0) + CHR$(75) OR a$ = CHR$(0) + CHR$(77) OR a$ = CHR$(0) + CHR$(72) OR a$ = CHR$(0) + CHR$(80) THEN LINE (x * 20 + 401, y * 10 + 201)-(x * 20 + 418, y * 10 + 208), 0, B
    : IF a$ = CHR$(0) + CHR$(75) THEN x = x - 1
    : IF a$ = CHR$(0) + CHR$(77) THEN x = x + 1
    : IF a$ = CHR$(0) + CHR$(72) THEN y = y - 1
    : IF a$ = CHR$(0) + CHR$(80) THEN y = y + 1
    : IF a$ = "C" THEN LOCATE 15, 5: INPUT "Byt till vilken ascii numer", a: achr = a: t = 3
    : IF a$ = "S" OR a$ = "W" OR a$ = "D" OR a$ = "A" THEN chrsave achr: LINE (B * 9, c * 18)-(B * 9 + 9, c * 18 + 17), 0, BF: skriv CHR$(achr), c * 18 + 1, B * 9, 7: t = 2
    : IF a$ = "S" THEN achr = achr + 65
    : IF a$ = "W" THEN achr = achr - 65
    : IF a$ = "D" THEN achr = achr + 1
    : IF a$ = "A" THEN achr = achr - 1
    : IF achr > 255 THEN achr = achr - 255 - 1
    : IF achr < 0 THEN achr = 255 + achr + 1
    : IF t = 2 THEN GOTO andr
    : IF t = 3 THEN GOTO start
    :
    : IF x > 7 THEN x = 7
    : IF x < 0 THEN x = 0
    : IF y > 15 THEN y = 15
    : IF y < 0 THEN y = 0
    : IF a$ = " " AND chr(x, y) = 0 THEN t = 1: chr(x, y) = 1: LINE (x * 20 + 407, y * 10 + 202)-(x * 20 + 413, y * 10 + 207), 7, BF
    : IF a$ = " " AND chr(x, y) = 1 AND t = 0 THEN chr(x, y) = 0: LINE (x * 20 + 407, y * 10 + 202)-(x * 20 + 413, y * 10 + 207), 0, BF
    :
    : LINE (x * 20 + 401, y * 10 + 201)-(x * 20 + 418, y * 10 + 208), 15, B
    : LOOP
    :
    : info:
    : CLS
    : PRINT "F1: This help side"
    : PRINT "F2: New font"
    : PRINT "F3: Save font"
    : PRINT "F4: Load font"
    : PRINT "F5: Erase font"
    : PRINT
    : PRINT "Up arrow: move up in pixel mode"
    : PRINT "Down arrow: move down in pixel mode"
    : PRINT "Right arrow: move right in pixel mode"
    : PRINT "Left arrow: move left in pixel mode"
    : PRINT "Space: Activate or unactivate the actual pixel"
    : PRINT
    : PRINT "W: move up in character mode"
    : PRINT "S: move down in character mode"
    : PRINT "D: move right in character mode"
    : PRINT "A: move left in character mode"
    : PRINT "C: change character"
    :
    : DO: LOOP UNTIL INKEY$ = ""
    : DO: LOOP UNTIL INKEY$ <> ""
    : GOTO start
    :
    : new:
    : ERASE chrS$
    : GOTO start
    :
    : save:
    : COLOR 7
    : SHELL "DIR *.chr"
    : PRINT "Save as:"
    : INPUT a$
    : IF a$ = "" THEN GOTO start
    : OPEN a$ + ".chr" FOR OUTPUT AS #1
    : CLOSE
    : KILL a$ + ".chr"
    :
    : OPEN a$ + ".chr" FOR OUTPUT AS #1
    : FOR a = 0 TO 255
    : PRINT #1, CHR$(LEN(chrS$(a)) + 128); chrS$(a);
    : NEXT
    : CLOSE
    : GOTO start
    :
    : load:
    : COLOR 7
    : SHELL "DIR *.chr"
    : PRINT "Load file:"
    : INPUT a$
    : IF a$ = "" THEN GOTO start
    : ERASE chrS$
    : loadchr (a$)
    : GOTO start
    :
    : dele:
    : COLOR 7
    : SHELL "DIR *.chr"
    : PRINT "Erase file:"
    : INPUT a$
    : IF a$ = "" THEN GOTO start
    : KILL a$ + ".chr"
    : GOTO start
    :
    : SUB chrsave (a)
    : DIM B(15)
    : chrS$(a) = ""
    :
    : FOR x = 0 TO 7
    : FOR y = 0 TO 15
    : IF chr(x, y) = 1 THEN B(y) = 1 ELSE B(y) = 0
    : NEXT y
    :
    : c = (B(0) * 128) + (B(1) * 64) + (B(2) * 32) + (B(3) * 16) + (B(4) * 8) + (B(5) * 4) + (B(6) * 2) + B(7)
    : c2 = (B(8) * 128) + (B(9) * 64) + (B(10) * 32) + (B(11) * 16) + (B(12) * 8) + (B(13) * 4) + (B(14) * 2) + B(15)
    :
    : IF chrS$(a) = "" THEN
    : IF c OR c2 THEN
    : chrS$(a) = CHR$(c)
    : chrS$(a) = chrS$(a) + CHR$(c2)
    : END IF
    : ELSE
    : chrS$(a) = chrS$(a) + CHR$(c)
    : chrS$(a) = chrS$(a) + CHR$(c2)
    : END IF
    :
    : NEXT x
    : FOR B = 0 TO LEN(chrS$(a)) - 1
    : IF RIGHT$(chrS$(a), 2) = CHR$(0) + CHR$(0) THEN chrS$(a) = LEFT$(chrS$(a), LEN(chrS$(a)) - 2)
    : NEXT B
    : END SUB
    :
    : DEFINT A-Z
    : SUB init
    : DIM B(15)
    :
    : FOR a = 0 TO 255
    : LOCATE 1, 1: COLOR 15: PRINT CHR$(0)
    : LOCATE 1, 1: COLOR 15: PRINT CHR$(a)
    : LOCATE 2, 1: COLOR 7
    : PRINT STR$(a / (255 / 100)); "% "
    : chrS$(a) = ""
    :
    : FOR x = 0 TO 7
    : FOR y = 0 TO 15
    : IF POINT(x, y) THEN B(y) = 1 ELSE B(y) = 0
    : NEXT y
    :
    : c = (B(0) * 128) + (B(1) * 64) + (B(2) * 32) + (B(3) * 16) + (B(4) * 8) + (B(5) * 4) + (B(6) * 2) + B(7)
    : c2 = (B(8) * 128) + (B(9) * 64) + (B(10) * 32) + (B(11) * 16) + (B(12) * 8) + (B(13) * 4) + (B(14) * 2) + B(15)
    :
    : IF chrS$(a) = "" THEN
    : IF c OR c2 THEN
    : chrS$(a) = chrS$(a) + CHR$(c)
    : chrS$(a) = chrS$(a) + CHR$(c2)
    : END IF
    : ELSE
    : chrS$(a) = chrS$(a) + CHR$(c)
    : chrS$(a) = chrS$(a) + CHR$(c2)
    : END IF
    :
    : NEXT x
    : FOR B = 0 TO LEN(chrS$(a)) - 1
    : IF RIGHT$(chrS$(a), 2) = CHR$(0) + CHR$(0) THEN chrS$(a) = LEFT$(chrS$(a), LEN(chrS$(a)) - 2)
    : NEXT B
    : NEXT a
    : END SUB
    :
    : DEFSNG A-Z
    : SUB loadchr (file$)
    : OPEN file$ + ".chr" FOR INPUT AS #1
    : FOR a = 0 TO 255
    : B = ASC(INPUT$(1, #1)) - 128
    : IF B > 0 THEN chrS$(a) = INPUT$(B, #1)
    : NEXT
    : CLOSE
    : END SUB
    :
    : DEFINT A-Z
    : SUB skriv (text$, rad, collumn, farg)
    : SHARED qw
    : IF qw = 4 THEN text$ = UCASE$(text$)
    :
    : FOR a = 0 TO LEN(text$) - 1
    : B = ASC(MID$(text$, a + 1))
    : IF B = 13 THEN rad = rad + 16
    : IF B = 9 THEN collumn = collumn + 64
    : IF B = 32 THEN collumn = collumn + 4
    :
    : FOR x = 0 TO (LEN(chrS$(B)) / 2) - 1
    : x3 = x3 + 1
    : c = ASC(MID$(chrS$(B), ((x * 2) + 1)))
    : c2 = ASC(MID$(chrS$(B), ((x * 2) + 2)))
    : x2 = x3 + collumn
    :
    : FOR p = 0 TO 7
    : IF (c AND 2 ^ p) / 2 ^ p THEN PSET (x2, rad + 7 + -p), farg
    : NEXT p
    : FOR p = 0 TO 7
    : IF (c2 AND 2 ^ p) / 2 ^ p THEN PSET (x2, rad + 15 + -p), farg
    : NEXT p, x
    : x3 = x3 + 1
    : NEXT a
    : END SUB
    :
    : [/code]
    : The descriptioin in the begining was for me to remember what it did...
    :
    : I hope I will be in the credits...
    :
    : The one and only [b]Niklas Ulvinge[/b] [white]aka [b]IDK[/b][/white]
    :
    :
    Woah, ok It took A while but I figured it out Ty soooooo much
    Should I put you down as Niklas Ulvinge or IDK?
    [hr]
    [purple][italic] I remain gentlemen your obedient servant [/purple]
    [b][red] -OG.[/italic][/b][/red]

    [white]-Margalo ;-) [/white]
    : :
  • [b][red]This message was edited by IDK at 2005-10-18 9:45:33[/red][/b][hr]

    Niklas Ulvinge aka IDK
    :-)

    The one and only [b]Niklas Ulvinge[/b] [white]aka [b]IDK[/b][/white]



Sign In or Register to comment.

Howdy, Stranger!

It looks like you're new here. If you want to get involved, click one of these buttons!

Categories