QBASIC fun

Off topic posts are welcome in this forum!
No smear campaign, or you will be banned!

Moderator: Mike Everman

Post Reply
PyroJoe
Posts: 1743
Joined: Wed Aug 29, 2007 5:44 pm
Antipspambot question: 125
Location: Texas

QBASIC fun

Post by PyroJoe » Thu Aug 18, 2011 3:04 pm

Summer is in full heat, doodling with qbasic and resting up until winter. Converted monochrome BMP to binary text file.
Attachments
PJ.TXT
(7.39 KiB) Downloaded 139 times
doodle.JPG
CLICK TO ENLARGE

WebPilot
Posts: 3716
Joined: Tue Dec 07, 2004 6:51 pm
Antipspambot question: 0
Location: 41d 1' N 80d 22' W

Re: QBASIC fun

Post by WebPilot » Tue Aug 30, 2011 3:16 am

How'd you do this - algorithm wise?
Image

PyroJoe
Posts: 1743
Joined: Wed Aug 29, 2007 5:44 pm
Antipspambot question: 125
Location: Texas

Re: QBASIC fun

Post by PyroJoe » Tue Aug 30, 2011 1:56 pm

It does ok, the BMP has to be upside down before converting, as the bmp data is scanned starting from the bottom to top. Unfortunately this also flips left and right. The offset also appears to shift from one BMP to another.

Up to line 550 of the program produces a header file (header.dat), so the details can be reviewed. In QBASIC using printing to the screen, the BMP can only be 80 pixels wide, due to the text field being only 80 characters wide. Printing to a raw.txt file it can go wider, I think 240 or something along those lines.

One difficult task was to find if the input represented a single or double hex number, used line 740 to check then passed it to the single numer pass of lines 790-930, or the double number pass of 1050-1120.

Counter/spooler three (spllr3) kept track of what line was being printed and ended the print goto loops before end of file

Could possibly be made shorter, and my sketty coding will look a fright to the current code formats.

Sketty code reads like a book to me, doesn't hide anything, warts an all. This was somewhat inspired by Linux Hascii Cam.


1 CLS
2 PRINT "printing header info to header.dat"
3 PRINT "assuming 1 byte = 8 binary bits"
5 OPEN "pj.bmp" FOR INPUT AS #1
6 OPEN "header.dat" FOR OUTPUT AS #9
7 LET A$ = (INPUT$(1, 1))
10 PRINT #9, A$
15 LET B$ = (INPUT$(1, 1))
20 PRINT #9, B$
25 LET C = ASC(INPUT$(1, 1))
30 PRINT #9, C; "-size of image with offset in bytes"
35 LET D = ASC(INPUT$(1, 1))
40 PRINT #9, D
45 LET E = ASC(INPUT$(1, 1))
50 PRINT #9, E
55 LET F = ASC(INPUT$(1, 1))
60 PRINT #9, F
65 LET g = ASC(INPUT$(1, 1))
70 PRINT #9, g
75 LET h = ASC(INPUT$(1, 1))
80 PRINT #9, h
85 LET i = ASC(INPUT$(1, 1))
90 PRINT #9, i
95 LET j = ASC(INPUT$(1, 1))
100 PRINT #9, j
105 LET k = ASC(INPUT$(1, 1))
110 PRINT #9, k; " -offset to bitmap in bytes--/end of 14 byte header"
115 LET l = ASC(INPUT$(1, 1))
120 PRINT #9, l
125 LET m = ASC(INPUT$(1, 1))
130 PRINT #9, m
135 LET n = ASC(INPUT$(1, 1))
140 PRINT #9, n
145 LET o = ASC(INPUT$(1, 1))
150 PRINT #9, o; " -size of structure/start of infoheader"
155 LET p = ASC(INPUT$(1, 1))
160 PRINT #9, p
165 LET q = ASC(INPUT$(1, 1))
170 PRINT #9, q
175 LET r = ASC(INPUT$(1, 1))
180 PRINT #9, r
185 LET s = ASC(INPUT$(1, 1))
190 PRINT #9, s; " -array width in pixels"
195 LET t = ASC(INPUT$(1, 1))
200 PRINT #9, t
205 LET u = ASC(INPUT$(1, 1))
210 PRINT #9, u
215 LET v = ASC(INPUT$(1, 1))
220 PRINT #9, v
225 LET w = ASC(INPUT$(1, 1))
230 PRINT #9, w; " -array height in pixels"
235 LET x = ASC(INPUT$(1, 1))
240 PRINT #9, x
245 LET y = ASC(INPUT$(1, 1))
250 PRINT #9, y
254 LET z = ASC(INPUT$(1, 1))
260 PRINT #9, z
265 LET aa = ASC(INPUT$(1, 1))
270 PRINT #9, aa; " -number of planes"
275 LET bb = ASC(INPUT$(1, 1))
280 PRINT #9, bb
285 LET cc = ASC(INPUT$(1, 1))
290 PRINT #9, cc; " -bits per pixel"
295 LET dd = ASC(INPUT$(1, 1))
300 PRINT #9, dd
305 LET ee = ASC(INPUT$(1, 1))
310 PRINT #9, ee; " -compression type"
315 LET ff = ASC(INPUT$(1, 1))
320 PRINT #9, ff
325 LET gg = ASC(INPUT$(1, 1))
330 PRINT #9, gg
335 LET hh = ASC(INPUT$(1, 1))
340 PRINT #9, hh
345 LET ii = ASC(INPUT$(1, 1))
350 PRINT #9, ii; " -image size without offset in bytes?"
355 LET jj = ASC(INPUT$(1, 1))
360 PRINT #9, jj; " -image size ?"
365 LET kk = ASC(INPUT$(1, 1))
370 PRINT #9, kk
375 LET ll = ASC(INPUT$(1, 1))
380 PRINT #9, ll
385 LET mm = ASC(INPUT$(1, 1))
390 PRINT #9, mm; " -horiz resolution in pix per meter"
395 LET nn = ASC(INPUT$(1, 1))
400 PRINT #9, nn
405 LET oo = ASC(INPUT$(1, 1))
410 PRINT #9, oo
415 LET pp = ASC(INPUT$(1, 1))
420 PRINT #9, pp
425 LET qq = ASC(INPUT$(1, 1))
430 PRINT #9, qq; " -vertical resolution in pix per meter"
435 LET rr = ASC(INPUT$(1, 1))
440 PRINT #9, rr
445 LET ss = ASC(INPUT$(1, 1))
450 PRINT #9, ss
455 LET tt = ASC(INPUT$(1, 1))
460 PRINT #9, tt
465 LET uu = ASC(INPUT$(1, 1))
470 PRINT #9, uu; " -number colors in image"
475 LET vv = ASC(INPUT$(1, 1))
480 PRINT #9, vv
485 LET ww = ASC(INPUT$(1, 1))
490 PRINT #9, ww
495 LET xx = ASC(INPUT$(1, 1))
500 PRINT #9, xx
505 LET yy = ASC(INPUT$(1, 1))
510 PRINT #9, yy; " -number of important colors/end of infoheader(40 bytes)"
515 LET zz = ASC(INPUT$(1, 1))
520 PRINT #9, zz; "RGB0=1110--if bits per pixel<=8 then this is color table info..so 54 + or not 4bytes"
525 REM-- add 3 more inputs if color is needed
550 PRINT "header file created 53 inputs collected"
551
552 LET rowcl = 8
553 PRINT "row clump size="; rowcl
554 LET rowttl = s / rowcl
555 PRINT "row has total clump width of:"; rowttl
564
565
566
567 OPEN "raw.txt" FOR OUTPUT AS #4
568
569 SLEEP
570 REM===================printing the array in binary======================
580 PRINT "======Attempting to print BMP in binary, width ="; s
585 OPEN "con" FOR OUTPUT AS #3 'opens up console window for input
590 SLEEP
591 spllr3 = 1
592
593
594 REM=====advancing to offset
600 LET offsett1 = k - 53 'offset minus all the inputs already read (53)
605 PRINT "offsetting"; offsett1
610 LET spllr1 = 0
620 LET offs1 = ASC(INPUT$(1, 1))
625 PRINT #9, offs1; "-offset"
630 IF spllr1 = offsett1 THEN GOTO 660
640 LET spllr1 = spllr1 + 1
650 GOTO 620
660 CLOSE #9
670 LET pix$ = ""
675
677
678 REM==========writing the width with bit groupings
679
680 LET spllr3 = 1
690
720 LET spllr2 = 1
725
730 LET pix1$ = (INPUT$(1, 1))
737 LET pix = ASC(pix1$)
738 LET pix$ = HEX$(pix)
739 LET chk1 = LEN(pix$)
740 IF chk1 > 1 THEN GOTO 1000 ELSE GOTO 790
741
742
745
750
760
790 IF pix$ = "0" THEN PRINT #4, "00000000";
795 IF pix$ = "1" THEN PRINT #4, "00000001";
800 IF pix$ = "2" THEN PRINT #4, "00000010";
805 IF pix$ = "3" THEN PRINT #4, "00000011";
810 IF pix$ = "4" THEN PRINT #4, "00000100";
815 IF pix$ = "5" THEN PRINT #4, "00000101";
820 IF pix$ = "6" THEN PRINT #4, "00000110";
825 IF pix$ = "7" THEN PRINT #4, "00000111";
830 IF pix$ = "8" THEN PRINT #4, "00001000";
835 IF pix$ = "9" THEN PRINT #4, "00001001";
840 IF pix$ = "A" THEN PRINT #4, "00001010";
845 IF pix$ = "B" THEN PRINT #4, "00001011";
850 IF pix$ = "C" THEN PRINT #4, "00001100";
855 IF pix$ = "D" THEN PRINT #4, "00001101";
860 IF pix$ = "E" THEN PRINT #4, "00001110";
865 IF pix$ = "F" THEN PRINT #4, "00001111";
890
900 IF spllr2 = rowttl THEN GOTO 2000
910 LET spllr2 = spllr2 + 1
930 GOTO 730
940
950
960
1000 LET pix2$ = (pix$)
1010 LET pixdbl1$ = LEFT$(pix$, 1)
1020 LET pixdbl2$ = RIGHT$(pix$, 1)
1040
1050 IF pixdbl1$ = "0" THEN PRINT #4, "0000";
1052 IF pixdbl1$ = "1" THEN PRINT #4, "0001";
1054 IF pixdbl1$ = "2" THEN PRINT #4, "0010";
1056 IF pixdbl1$ = "3" THEN PRINT #4, "0011";
1058 IF pixdbl1$ = "4" THEN PRINT #4, "0100";
1060 IF pixdbl1$ = "5" THEN PRINT #4, "0101";
1062 IF pixdbl1$ = "6" THEN PRINT #4, "0110";
1064 IF pixdbl1$ = "7" THEN PRINT #4, "0111";
1066 IF pixdbl1$ = "8" THEN PRINT #4, "1000";
1068 IF pixdbl1$ = "9" THEN PRINT #4, "1001";
1070 IF pixdbl1$ = "A" THEN PRINT #4, "1010";
1072 IF pixdbl1$ = "B" THEN PRINT #4, "1011";
1074 IF pixdbl1$ = "C" THEN PRINT #4, "1100";
1076 IF pixdbl1$ = "D" THEN PRINT #4, "1101";
1078 IF pixdbl1$ = "E" THEN PRINT #4, "1110";
1080 IF pixdbl1$ = "F" THEN PRINT #4, "1111";
1081
1082 IF pixdbl2$ = "0" THEN PRINT #4, "0000";
1084 IF pixdbl2$ = "1" THEN PRINT #4, "0001";
1086 IF pixdbl2$ = "2" THEN PRINT #4, "0010";
1088 IF pixdbl2$ = "3" THEN PRINT #4, "0011";
1090 IF pixdbl2$ = "4" THEN PRINT #4, "0100";
1092 IF pixdbl2$ = "5" THEN PRINT #4, "0101";
1094 IF pixdbl2$ = "6" THEN PRINT #4, "0110";
1096 IF pixdbl2$ = "7" THEN PRINT #4, "0111";
1098 IF pixdbl2$ = "8" THEN PRINT #4, "1000";
1100 IF pixdbl2$ = "9" THEN PRINT #4, "1001";
1102 IF pixdbl2$ = "A" THEN PRINT #4, "1010";
1104 IF pixdbl2$ = "B" THEN PRINT #4, "1011";
1106 IF pixdbl2$ = "C" THEN PRINT #4, "1100";
1108 IF pixdbl2$ = "D" THEN PRINT #4, "1101";
1110 IF pixdbl2$ = "E" THEN PRINT #4, "1110";
1112 IF pixdbl2$ = "F" THEN PRINT #4, "1111";
1113
1114 IF spllr2 = rowttl THEN GOTO 2000
1116 LET spllr2 = spllr2 + 1
1120 GOTO 730
1130
1140
1150
2000 REM==========printing one line after the last to make height
2200 PRINT #4, ""
2300 IF spllr3 = (s + ii - 1) THEN GOTO 3000
2400 LET spllr3 = spllr3 + 1
2600 GOTO 690
2700
2800
2900
3000
3010 PRINT #3, "row", spllr3
3015 CLOSE #4
3020 CLOSE #3
3025 CLOSE #1
3030 END
Last edited by PyroJoe on Tue Aug 30, 2011 7:26 pm, edited 2 times in total.

PyroJoe
Posts: 1743
Joined: Wed Aug 29, 2007 5:44 pm
Antipspambot question: 125
Location: Texas

Re: QBASIC fun

Post by PyroJoe » Tue Aug 30, 2011 2:23 pm

Very buggy, but when it works its kinda neat. The bitmap header and scan data has to be very clean, to much adjustment on the bmp will scramble things to the point of no return. note the font size is very low, (3 for the top one).
Attachments
mfox.TXT
font size set to 3
(34 KiB) Downloaded 143 times
mfox.JPG
tree.TXT
(36.38 KiB) Downloaded 131 times
tree.JPG

WebPilot
Posts: 3716
Joined: Tue Dec 07, 2004 6:51 pm
Antipspambot question: 0
Location: 41d 1' N 80d 22' W

Re: QBASIC fun

Post by WebPilot » Thu Sep 01, 2011 3:48 am

flowchart?
Image

PyroJoe
Posts: 1743
Joined: Wed Aug 29, 2007 5:44 pm
Antipspambot question: 125
Location: Texas

Re: QBASIC fun

Post by PyroJoe » Thu Sep 01, 2011 4:16 pm

Hope this helps,
Attachments
QD.jpg

WebPilot
Posts: 3716
Joined: Tue Dec 07, 2004 6:51 pm
Antipspambot question: 0
Location: 41d 1' N 80d 22' W

Re: QBASIC fun

Post by WebPilot » Fri Sep 02, 2011 3:55 am

Thanks. I'll take a deeper look at it tonight. I've been working on my car's wiring.

How do you think the guys incorporated ascii text into this? I'm sure you've seen this.
Image

tufty
Posts: 845
Joined: Wed Dec 24, 2003 12:12 pm
Antipspambot question: 0
Location: France
Contact:

Re: QBASIC fun

Post by tufty » Fri Sep 02, 2011 11:04 am

Nice work.

aalib is what's usually used to do this. VLC has an aalib output, which is kinda fun.

The most fun, though, is to telnet to port 23 of towel.blinkenlights.nl ([url=telnet://towel.blinkenlights.nl:23]this link might work in some browsers[/url]). It's not *exactly* image to text, but sorta.

WebPilot
Posts: 3716
Joined: Tue Dec 07, 2004 6:51 pm
Antipspambot question: 0
Location: 41d 1' N 80d 22' W

Re: QBASIC fun

Post by WebPilot » Fri Sep 02, 2011 11:38 am

I remember a code that generated ascii text art of a Playboy centerfold. This was back in the early 70's using a mainframe, data cards and a lineprinter.

I created this over a year ago and posted in Re: Linux glitches ... an image of a Laura Croft - like character using grey scale ascii.

Image

Image
Image

PyroJoe
Posts: 1743
Joined: Wed Aug 29, 2007 5:44 pm
Antipspambot question: 125
Location: Texas

Re: QBASIC fun

Post by PyroJoe » Fri Sep 02, 2011 1:16 pm

This one works well and is in color:
http://www.text-image.com/index.html

WebPilot
Posts: 3716
Joined: Tue Dec 07, 2004 6:51 pm
Antipspambot question: 0
Location: 41d 1' N 80d 22' W

Re: QBASIC fun

Post by WebPilot » Fri Sep 02, 2011 6:43 pm

Thanks Joe.
Image

WebPilot
Posts: 3716
Joined: Tue Dec 07, 2004 6:51 pm
Antipspambot question: 0
Location: 41d 1' N 80d 22' W

Re: QBASIC fun

Post by WebPilot » Fri Sep 09, 2011 7:08 pm

This spring it rained an inordinate amount here.

I finished working on a '93 Honda Civic (late winter, all spring until the first day of summer) and successfully got it to pass the required emissions test and the general safety check. I fixed the cause of my XS-650 fouling one plug and generally not allowing any carb adjustments on the right cylinder.

Then abruptly, summer arrived stinking hot, 90+ and high humidity. It was too hot for me to do much of anything outside.

So, I went back to work myself on a QBasic program, too, until late July when it started to become more reasonable outside.
Image

WebPilot
Posts: 3716
Joined: Tue Dec 07, 2004 6:51 pm
Antipspambot question: 0
Location: 41d 1' N 80d 22' W

Re: QBASIC fun

Post by WebPilot » Fri Sep 16, 2011 7:03 am

Now it's starting to get cold again ... 40degF at night.

I may be returning to QB sooner than I thought.
Image

Post Reply