tTh/Fortraneries
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Compare commits

base: tTh:a1c0bf6e34921495c864b8704cbbab61e345faf7
Branches Tags
tTh:master
...
compare: tTh:8ea11d110b0a89ae3a876ecebac990468ef3d27a
Branches Tags
tTh:master

2 Commits
a1c0bf6e34 ... 8ea11d110b

Author SHA1 Message Date
tTh
8ea11d110b cleanup + add a 0 func 2022-12-24 22:13:17 +01:00
tTh
ab601629e5 obscure bug fixed 2022-12-24 22:11:31 +01:00
5 changed files with 287 additions and 20 deletions
Show Stats Expand all files Collapse all files

13
Fraktalism/mods/fractcolmap.f90
View File

@ -58,17 +58,20 @@ subroutine fcolm_plot_mapfile(fname)
write(0, *) ' -> fractcolmap plot map to [', fname, ']'
allocate(prgb(512, 128), stat=errcode)
! Please, add a molly-guard
if (0 .NE. errcode) then
write(0, *) "errcode allocate in plot_map: ", errcode
STOP 'ABEND'
endif
print *, ' FILE ', fname
call rgbpix_set_to_zero(prgb)
! print *, ' FILE ', fname
do ix = 1, 255
call fcolm_get_rgb(ix-1, rgb)
call fcolm_get_rgb(ix, rgb)
xx = ix * 2
! print *, ix, xx, " => ", rgb
do iy=1, 128
prgb( xx, iy)%r = rgb(1)
prgb(1+xx, iy)%r = rgb(1)
@ -79,7 +82,9 @@ subroutine fcolm_plot_mapfile(fname)
enddo
enddo
! push all the colred dats to disk
! write(0, *) 'first pixel', prgb(1, 1)
!- push all the colred dats to disk
call rgbpix_spit_as_pnm_8(prgb, fname)
deallocate(prgb)

256
Fraktalism/mods/headache.map Normal file
View File

@ -0,0 +1,256 @@
0 0 0 headache.map contributed by Daniel Egnor
240 0 0
0 252 0
240 0 0
0 252 0
240 0 0
0 248 4
240 4 0
0 248 4
240 4 0
0 244 8
240 8 0
0 244 8
240 8 0
0 240 12
240 12 0
0 240 12
240 12 0
0 236 16
240 16 0
0 236 16
240 16 0
0 232 20
240 20 0
0 232 20
240 20 0
0 228 24
240 24 0
0 228 24
240 24 0
0 224 28
240 28 0
0 224 28
240 28 0
0 220 32
240 32 0
0 220 32
240 32 0
0 216 36
240 36 0
0 216 36
240 36 0
0 212 40
240 40 0
0 212 40
240 40 0
0 208 44
240 44 0
0 208 44
240 44 0
0 204 48
240 48 0
0 204 48
240 48 0
0 200 52
240 52 0
0 200 52
240 52 0
0 196 56
240 56 0
0 196 56
240 56 0
0 192 60
240 60 0
0 192 60
240 60 0
0 188 64
240 64 0
0 188 64
240 64 0
0 184 68
240 68 0
0 184 68
240 68 0
0 180 72
240 72 0
0 180 72
240 72 0
0 176 76
240 76 0
0 176 76
240 76 0
0 172 80
240 80 0
0 172 80
240 80 0
0 168 84
244 84 0
0 168 84
244 84 0
0 164 88
244 88 0
0 164 88
244 88 0
0 160 92
244 92 0
0 160 92
244 92 0
0 156 96
244 96 0
0 156 96
244 96 0
0 152 100
244 100 0
0 152 100
244 100 0
0 148 104
244 104 0
0 148 104
244 104 0
0 144 108
244 108 0
0 144 108
244 108 0
0 140 112
244 112 0
0 140 112
244 112 0
0 136 116
244 116 0
0 136 116
244 116 0
0 132 120
244 120 0
0 132 120
244 120 0
0 128 124
244 124 0
0 128 124
244 124 0
0 124 128
244 128 0
0 124 128
244 128 0
0 120 132
244 132 0
0 120 132
244 132 0
0 116 136
244 136 0
0 116 136
244 136 0
0 112 140
244 140 0
0 112 140
244 140 0
0 108 144
244 144 0
0 108 144
244 144 0
0 104 148
244 148 0
0 104 148
244 148 0
0 100 152
244 152 0
0 100 152
244 152 0
0 96 156
244 156 0
0 96 156
244 156 0
0 92 160
244 160 0
0 92 160
244 160 0
0 88 164
244 164 0
0 88 164
244 164 0
0 84 168
248 168 0
0 84 168
248 168 0
0 80 172
248 172 0
0 80 172
248 172 0
0 76 176
248 176 0
0 76 176
248 176 0
0 72 180
248 180 0
0 72 180
248 180 0
0 68 184
248 184 0
0 68 184
248 184 0
0 64 188
248 188 0
0 64 188
248 188 0
0 60 192
248 192 0
0 60 192
248 192 0
0 56 196
248 196 0
0 56 196
248 196 0
0 52 200
248 200 0
0 52 200
248 200 0
0 48 204
248 204 0
0 48 204
248 204 0
0 44 208
248 208 0
0 44 208
248 208 0
0 40 212
248 212 0
0 40 212
248 212 0
0 36 216
248 216 0
0 36 216
248 216 0
0 32 220
248 220 0
0 32 220
248 220 0
0 28 224
248 224 0
0 28 224
248 224 0
0 24 228
248 228 0
0 24 228
248 228 0
0 20 232
248 232 0
0 20 232
248 232 0
0 16 236
248 236 0
0 16 236
248 236 0
0 12 240
248 240 0
0 12 240
248 240 0
0 8 244
248 244 0
0 8 244
248 244 0
0 4 248
248 248 0
0 4 248
252 252 0
252 128 0
0 128 128

3
Fraktalism/mods/t.f90
View File

@ -14,6 +14,9 @@ program t
call fcolm_load_mapfile('chroma.map')
call fcolm_plot_mapfile('chroma.pnm')
call fcolm_load_mapfile('headache.map')
call fcolm_plot_mapfile('headache.pnm')
STOP 'BECAUSE YOU WAS OUMPFED.'
contains

11
Modules/chkpixels.f90
View File

@ -18,6 +18,8 @@ program chkpixels
contains
!-------------------------------------------------------------------
!-
! exerciser for the 'pixrgb' module
!-
subroutine test_spit_rgb(sz)
integer, intent(in) :: sz
@ -27,20 +29,15 @@ contains
print *, "test spit rgb", sz
allocate(pixrgb(sz, sz))
! pixrgb = 0
call rgbpix_set_to_zero(pixrgb)
do ix=1, sz
do iy=1, sz
pixrgb(ix, iy)%r = ix
pixrgb(ix, iy)%g = 0
pixrgb(ix, iy)%b = iy
end do
end do
call rgbpix_spit_as_pnm_8(pixrgb, "rgb.pnm")
deallocate(pixrgb)
end subroutine
@ -60,12 +57,10 @@ contains
value = value + increment
enddo
enddo
call spit_as_pgm_16 (greymap, 'a.pgm')
call spit_as_pgm_eq (greymap, 'b.pgm')
call spit_as_pgm_8 (greymap, 'c.pgm')
call new_spit_a (greymap, 'x.pgm')
end subroutine
end program

24
Modules/pixrgb.f90
View File

@ -15,8 +15,20 @@ end type
contains
!-------------------------------------------------------------------
!-
subroutine rgbpix_set_to_zero(pic)
type(t_pixrgb), intent(out) :: pic(:,:)
integer :: ix, iy
do iy=1, ubound(pic, 2)
do ix=1, ubound(pic, 1)
pic(ix, iy)%r = 0
pic(ix, iy)%g = 0
pic(ix, iy)%b = 0
enddo
enddo
end subroutine
!-------------------------------------------------------------------
!-
subroutine rgbpix_spit_as_pnm_8(pic, fname)
type(t_pixrgb), intent(in) :: pic(:,:)
character (len=*), intent(in) :: fname
@ -25,14 +37,12 @@ subroutine rgbpix_spit_as_pnm_8(pic, fname)
open(newunit=io, file=fname)
write (io, '(a2)') "P3"
write (io, '("# rgbpix_spit_as_pnm_8")')
write (io, '(i0," ",i0)') size(pic, 1), size(pic, 2)
write (io, '(i0," ",i0)') size(pic, 1), size(pic, 2)
write (io, '(i0)') 255
do iy=1, ubound(pic, 2)
do ix=1, ubound(pic, 1)
write(io, "(3I4)") pic(ix, iy)%r, pic(ix, iy)%g, pic(ix, iy)%b
write(io, "(3I12)") pic(ix, iy)%r, pic(ix, iy)%g, pic(ix, iy)%b
enddo
enddo
close(unit=io)
@ -55,9 +65,7 @@ subroutine rgbpix_spit_as_pnm_16(pic, fname)
do iy=1, ubound(pic, 2)
do ix=1, ubound(pic, 1)
write(io, "(3I6)") pic(ix, iy)%r, pic(ix, iy)%g, pic(ix, iy)%b
write(io, "(3I6)") pic(ix, iy)%r, pic(ix, iy)%g, pic(ix, iy)%b
enddo
enddo
close(unit=io)