From 0f31824a5e4969d56d88678e05274163be3d8b77 Mon Sep 17 00:00:00 2001 From: Jeffrey Armstrong Date: Fri, 7 May 2021 09:42:16 -0400 Subject: Instructions and players now displayed via the CGI interface. Added 'page' member to the request derived type. --- captain/web.f90 | 231 ++++++++++++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 225 insertions(+), 6 deletions(-) (limited to 'captain/web.f90') diff --git a/captain/web.f90 b/captain/web.f90 index 423f7ed..55f12a0 100644 --- a/captain/web.f90 +++ b/captain/web.f90 @@ -64,6 +64,225 @@ contains end function html_link + function generate_one_instuction_html(req) result(res) + use captain_db + use server_response + use request_utils, only: get_status_utf8, render_jobs_links + implicit none + + type(request)::req + character(len=:), pointer::res + integer::id_from_req + + character(128)::instruction_name + type(job), dimension(:), pointer::jobs + integer, dimension(:), pointer::players + character(len=PLAYER_NAME_LENGTH), dimension(:), pointer::all_players + integer::i, j, n_jobs, n_players, nsize + + character(len=:), pointer::job_link_text, one_link + character(1)::nl = new_line(' ') + character(PLAYER_NAME_LENGTH)::player_name + character(4)::player_status + + i = index(req%page, ".html") + instruction_name = req%page(1:i-1) + id_from_req = get_instruction_id(trim(instruction_name)) + + jobs => get_jobs_for_instruction(id_from_req) + + if(associated(jobs)) then + n_jobs = size(jobs) + job_link_text => render_jobs_links(jobs, gemini_mode=.false., link_prefix="../") + else + n_jobs = 0 + job_link_text => null() + end if + + players => get_instruction_players(id_from_req) + if(associated(players)) then + n_players = size(players) + else + n_players = 0 + end if + + nsize = 1024 + if(n_jobs > 0) then + nsize = nsize + len_trim(job_link_text) + end if + if(n_players > 0) then + nsize = nsize + n_players*(2*PLAYER_NAME_LENGTH+64) + end if + + nsize = nsize + get_player_count()*(2*PLAYER_NAME_LENGTH+64) + + allocate(character(len=nsize) :: res) + + res = "

"//trim(instruction_name)//"

" + + one_link => html_link(trim(instruction_name)//".json", & + "View Raw") + res = trim(res)//nl//"

"//one_link//"

" + deallocate(one_link) + + if(n_players == 0) then + res = trim(res)//nl//"

No players currently can run these instructions

" + else + res = trim(res)//nl//"

Launch Now

"//nl//"" + end if + + res = trim(res)//nl//"

Jobs

" + if(n_jobs == 0) then + res = trim(res)//nl//"None Yet" + else + res = trim(res)//nl//job_link_text + deallocate(job_link_text) + end if + + all_players => get_player_names() + if(associated(all_players)) then + res = trim(res)//nl//"

Assign

"//nl//"

Assign a player to these instructions

"//nl//"" + deallocate(all_players) + end if + + if(n_players > 0) then + res = trim(res)//nl//"

Remove

"//nl//"

Remove a player from these instructions

"//nl//"" + end if + + end function generate_one_instuction_html + + function generate_instructions_html() result(res) + use captain_db + implicit none + + character(len=:), pointer::res + character(len=PLAYER_NAME_LENGTH), dimension(:), pointer::instruction_names + integer::n, i, nsize + + character(len=:), pointer::one_player + + n = get_instuctions_count() + + if(n == 0) then + + allocate(character(len=1024) :: res) + res = "None Yet" + + else + + instruction_names => get_instruction_names() + nsize = 1024 + do i = 1, size(instruction_names) + nsize = nsize + 16 + 2*len_trim(instruction_names(i)) + end do + + allocate(character(len=nsize) :: res) + res = "

Instructions

"//new_line(' ')//"" + + deallocate(instruction_names) + + end if + + res = trim(res)//new_line(' ')//"

Management

"// & + new_line(' ')//"coming soon (Scan for Instructions)" + + end function generate_instructions_html + + function generate_players_html() result(res) + use captain_db + implicit none + + character(len=:), pointer::res + character(len=PLAYER_NAME_LENGTH), dimension(:), pointer::players + integer::n, i, nsize + + character(len=:), pointer::one_player + + n = get_player_count() + if(n == 0) then + + allocate(character(len=1024) :: res) + + res = "None Yet" + + else + + players => get_player_names() + + nsize = 1024 + do i = 1, size(players) + nsize = nsize + 16 + 2*len_trim(players(i)) + end do + + allocate(character(len=nsize) :: res) + res = "

Existing Players

"//new_line(' ')//"" + deallocate(players) + end if + + res = trim(res)//new_line(' ')//"

Management

"// & + new_line(' ')//"

coming soon (add player)

" + + end function generate_players_html + function generate_one_job_html(req) result(res) use captain_db use server_response @@ -356,8 +575,8 @@ contains else if(trim(req%location) == "/players.html") then call page%assign('title', 'Players') - !contents => generate_players_gemini() - !call page%assign('contents', contents) + contents => generate_players_html() + call page%assign('contents', contents) else if(req%location(1:9) == '/players/') then @@ -368,14 +587,14 @@ contains else if(trim(req%location) == "/instructions.html") then call page%assign('title', 'Build Instructions') - !contents => generate_instructions_gemini() - !call page%assign('contents', contents) + contents => generate_instructions_html() + call page%assign('contents', contents) else if(trim(first) == "instructions") then call page%assign('title', 'Build Instructions') - !contents => generate_one_instuction_gemini(req) - !call page%assign('contents', contents) + contents => generate_one_instuction_html(req) + call page%assign('contents', contents) else if(trim(first) == "jobs") then -- cgit v1.2.3