Personaje

[mnrvovrfc]

This is not the program that I used to come up with the attachment in an earlier post here. It involved two programs. Therefore I rewrote the program. This only produces symmetrical ASCII monstrosities. In addition it does some skewing of the half-images. This follows the concept of QBasic "Nibbles" program which involved the half-blocks up and down to create a 80x50 virtual screen.

The output file of this program should be loaded into the QB64 IDE only. Otherwise it requires CP437 or IBM852 codepage.

Code: (Select All)

'by mnrvovrfc 30-Jan-2023
$CONSOLE:ONLY
OPTION _EXPLICIT
DIM s(1 TO 50, 1 TO 80) AS _BYTE
DIM x(1 TO 1000) AS SINGLE, y(1 TO 1000) AS SINGLE
DIM ss(1 TO 25) AS STRING
DIM AS SINGLE xc, yc, a, b, c, d, e, f, g, h, i1, i2, xp, yp, xn, yn
DIM AS INTEGER i, j, co, cl, cq, ro, cx, cc, xx, yy
DIM a$, afile$, bb AS _BYTE, cfix AS _BYTE, fo AS LONG

'RANDOMIZE TIMER

$IF WIN THEN
afile$ = ENVIRON$("USERPROFILE") + "\Documents\plotfaye-blocks.txt"
$ELSE
afile$ = ENVIRON$("HOME") + "/Documents/plotfaye-blocks.txt"
$END IF
fo = FREEFILE
OPEN afile$ FOR OUTPUT AS fo
FOR j = 1 TO 1000
    DO
        a = Random1(40)
        c = Random1(40)
        e = Random1(40)
        g = Random1(40)
    LOOP WHILE (a < 11 AND c < 11) OR (e < 11 AND g < 11)
    IF a < 11 THEN a = 1 ELSE a = a / 10
    IF c < 11 THEN c = 1 ELSE c = c / 10
    IF e < 11 THEN e = 1 ELSE e = e / 10
    IF g < 11 THEN g = 1 ELSE g = g / 10
    xn = 1
    yn = 1
    xp = 1
    yp = 1
    b = (Random1(11) + 9) / 10
    d = (Random1(11) + 9) / 10
    f = (Random1(11) + 9) / 10
    h = (Random1(11) + 9) / 10
    cc = Random1(8)
    i1 = (Random1(4) + 1) / 100
    i2 = (Random1(4) + 1) / 100
    xc = 1E+6
    yc = 1E+6
    FOR i = 1 TO 1000
        IF i > 600 THEN cc = cc + 2
        IF i > 850 THEN cc = cc + 2
        x(i) = a * COS(b * i / 4) + c * SIN(d * i / 4)
        y(i) = e * SIN(f * i / 4) + g * SIN(h * i / 4)
        IF x(i) < 0 THEN x(i) = x(i) * xn ELSE x(i) = x(i) * xp
        IF y(i) < 0 THEN y(i) = y(i) * yn ELSE y(i) = y(i) * yp
        IF ABS(x(i)) < xc THEN xc = ABS(x(i))
        IF ABS(y(i)) < yc THEN yc = ABS(y(i))
        SELECT CASE cc
            CASE 1, 2
                xp = xp + 0.01
            CASE 3, 4
                yp = yp + 0.01
            CASE 5
                xp = xp + i1
            CASE 6
                xn = xn + i1
            CASE 7
                yp = yp + i1
            CASE 8
                yn = yn + i1
            CASE 9
                xp = xp + 0.01
                yn = yn + i1
            CASE 10
                xn = xn + i1
                yp = yp + 0.01
            CASE 11
                xp = xp + i1
                yn = yn + i2
            CASE 12
                xn = xn + i1
                yp = yp + i2
        END SELECT
    NEXT 'i
    ERASE s
    FOR i = 1 TO 1000
        xx = INT(x(i) - xc) + 20
        yy = INT(y(i) - yc) + 25
        IF xx > 0 AND xx <= 80 AND yy > 0 AND yy <= 50 THEN s(yy, xx) = 1
    NEXT
    ro = 0
    FOR i = 1 TO 49 STEP 2
        ro = ro + 1
        ss(ro) = SPACE$(80)
        cc = 0
        cq = 0
        FOR co = 1 TO 80
            IF s(i, co) = 1 AND s(i + 1, co) = 1 THEN
                MID$(ss(ro), co, 1) = "#"
            ELSEIF s(i, co) = 1 THEN
                MID$(ss(ro), co, 1) = "'"
            ELSEIF s(i + 1, co) = 1 THEN
                MID$(ss(ro), co, 1) = "."
            END IF
        NEXT 'o
    NEXT 'i
    cl = 0
    FOR ro = 1 TO 25
        a$ = RTRIM$(ss(ro))
        cq = LEN(a$)
        IF cq > cl THEN cl = cq
    NEXT
    FOR ro = 1 TO 25
        ss(ro) = LEFT$(ss(ro), cl)
        FOR co = cl - 1 TO 1 STEP -1
            ss(ro) = ss(ro) + MID$(ss(ro), co, 1)
        NEXT 'co
    NEXT 'ro
    cx = 0
    FOR co = 1 TO 80
        FOR ro = 1 TO 25
            a$ = _TRIM$(ss(ro))
            IF a$ <> "" THEN
                IF MID$(ss(ro), co, 1) <> " " THEN cx = co: EXIT FOR
            END IF
        NEXT 'ro
        IF cx > 0 THEN EXIT FOR
    NEXT 'co
    IF cx > 0 THEN
        FOR ro = 1 TO 25
            a$ = _TRIM$(ss(ro))
            IF a$ = "" THEN
                ss(ro) = ""
            ELSE
                ss(ro) = MID$(ss(ro), cx)
                cq = 0
                FOR co = 1 TO LEN(ss(ro))
                    bb = ASC(ss(ro), co)
                    IF bb <> 32 THEN cq = co: EXIT FOR
                NEXT
                IF cq > 0 THEN
                    FOR co = 1 TO cq - 1
                        MID$(ss(ro), co, 1) = CHR$(95)
                    NEXT 'co
                    ss(ro) = RTRIM$(ss(ro))
                ELSE
                    ss(ro) = ""
                END IF
            END IF
        NEXT 'ro
    END IF
    FOR ro = 1 TO 25
        IF ss(ro) <> "" THEN
            'PRINT ss(ro)
            ReplaceString2 ss(ro), "#", CHR$(219), 0
            ReplaceString2 ss(ro), ".", CHR$(220), 0
            ReplaceString2 ss(ro), "'", CHR$(223), 0
            PRINT #fo, ss(ro)
        END IF
    NEXT 'ro
    'PRINT "---"
    PRINT #fo, "---"
    PRINT i
NEXT 'j
CLOSE fo
PRINT "Output file write completed."
SYSTEM


FUNCTION Random1& (maxval AS LONG)
    Random1& = INT(RND * maxval + 1)
END FUNCTION


SUB ReplaceString2 (tx AS STRING, sfind AS STRING, repl AS STRING, numtimes AS _UNSIGNED LONG)
    DIM s AS STRING, t AS STRING, goahead AS _BYTE
    DIM AS _UNSIGNED LONG ls, u, count
    IF (tx = "") OR (sfind = "") OR (sfind = repl) OR (LEN(sfind) > LEN(tx)) THEN EXIT SUB
    s = UCASE$(sfind): t = UCASE$(tx)
    ls = LEN(s)
    count = 0
    goahead = 1
    DO
        u = INSTR(t, s)
        IF u > 0 THEN
            tx$ = LEFT$(tx, u - 1) + repl + MID$(tx$, u + ls)
            t = UCASE$(tx)
            IF numtimes > 0 THEN count = count + 1: IF count >= numtimes THEN goahead = 0
        ELSE
            goahead = 0
        END IF
    LOOP WHILE goahead
END SUB